Numero romano a numero pero por código
Tengo un problema no se que puedo estar hacendó mal, ademas se que no es lo que deseo pero anda por allí, lo que quiero hacer es por medio de código pasar de un numero romano a un numero corriente, par alo cual utilicé este código 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 daría como resultado CL, como ves el mayor va de primero y después 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, así, espero que 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
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 daría como resultado CL, como ves el mayor va de primero y después 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, así, espero que 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
1 Respuesta
Respuesta de fejoal
1
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
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
