Inicio > Microsoft Excel > fejoal > Numero romano a numero pero por código

Numero romano a numero pero por código

Experto:
Usuario:
Fecha: 12/10/2008
Valoración: (5,00 sobre 5) Categoría: Microsoft Excel
12/10/2008
retana, usuario preguntando en Microsoft Excel
Usuario
tengo un problema no se que puedo estar hacendo mal, ademas se que no es lo que deseo pero anda por alli, lo que quiero hacer es por medio de codigo pasar de un numero romano a un numero corriente, par alo cual utilicé este codigo pero no se porque no me da resultado.

ademas no solo eso, no se como introducir ciertos criterios como en el caso del 4 y 9, dado de que en estos casos el primer numero es menos y el segundo mayor, caso contrario con escribir 150 el cual uno daria como resultado CL, como ves el mayor va de primero y despues el menor, a diferencia de escribir 149 CXLIX, ese es mi pequeño problema. en este caso yo coloco el la caja de texto de nombre txtinicio el numero romano para tratar de convertirlo, ademas no se como es que se hace para que una variable vaya acumulando, es decir si consta de 5 letras que sume el valor de la primera, segunda,tercera, asi, esperoq ue me podas dar una mano

For I = 1 To Len(LTrim(RTrim((txtinicio.Text))))
oper = Mid(UCase(RTrim(LTrim(txtinicio.Text))), I, 1)
Select Case oper
Case "I": dig = 1
Case "V": dig1 = 5
Case "X": dig2 = 10
Case "L": dig3 = 50
Case "C": dig4 = 100
Case "D": dig5 = 500
Case "M": dig6 = 1000
Case "G": dig7 = 5000
End Select
total = dig + dig1 + dig2 + dig3 + dig4 + dig5 + dig6 + dig7
Next I
Roman_Numero = total

de ante mano muchas Gracias
12/10/2008
retana, experto respondiendo en Microsoft Excel
Experto

Hola, Gerardo!

Bien, aquí sigue el código que armé para convertir el valor romano ingresado en un textbox (o podría ser una celda en la hoja)

Ya sabes, inserta un módulo nuevo y pega en él el siguiente procedimiento:

Sub romano()
numRom = UCase(Trim(txtinicio.Text))
Oper = "Svm"
For Letra = Len(numRom) To 1 Step -1
Ultletra = Mid(numRom, Letra, 1)
If Letra > 1 Then
PenuLetra = Mid(numRom, Letra - 1, 1)
Else
PenuLetra = "Fine"
End If
VUltletra = Rom2Arab(Ultletra)
If PenuLetra = "Fine" Then
VPenuletra = 0
Else
VPenuletra = Rom2Arab(PenuLetra)
End If
If Left(VUltletra, 2) = "No" Or Left(VPenuletra, 2) = "No" Then
MsgBox "Caracteres no romanos", vbCritical, "Error de letras"
Exit Sub
Else
If Oper = "Svm" Then
Totalus = Totalus + VUltletra
Else
Totalus = Totalus - VUltletra
End If
End If
If Not VPenuletra Then
Oper = IIf(VUltletra <= VPenuletra, "Svm", "Restum")
Else
Exit For
End If
Next Letra
MsgBox "El número es: " & Totalus
End Sub

Private Function Rom2Arab(Letra)

Select Case Letra
Case "I": dig = 1
Case "V": dig = 5
Case "X": dig = 10
Case "L": dig = 50
Case "C": dig = 100
Case "D": dig = 500
Case "M": dig = 1000
Case "G": dig = 5000
Case Else: dig = "No existe caracter"
End Select
Rom2Arab = dig
End Function

Nota que hay una función interna que hace la conversión de la letra a un número y lo devuelve al código principal (romano)
Finalmente obtienes una cuador de mensaje con el resultado. Pero como, en definitiva, muestra el contenido de una variable, puedes usarla como necesites.

Ojalá sea lo que buscas.

Un abrazo!
Fernando

Espero que te sirva
12/10/2008
retana, usuario preguntando en Microsoft Excel
Usuario
wuauuuuuuuu esta excelente, muchisimas gracias
Enlaces patrocinados