Título: [SNIPPET] Decimal a Romano
Publicado por: Karcrack en 16 Diciembre 2010, 16:27 pm
Discutiendo con un amigo; la forma mas corta que se me ocurrio: Public Function DecToRoman(ByVal lNum As Long) As String DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX") lNum = lNum - (lNum Mod 10) DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman lNum = lNum - (lNum Mod 100) DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman End Function
Saludos ;)
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: agus0 en 17 Diciembre 2010, 01:34 am
✗ Gracias ✗
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: Psyke1 en 17 Diciembre 2010, 02:24 am
Buena Karcrack, esta muy claro de entender. :) No te gusta más así? Public Function DecToRoman(ByVal lNum As Long) As String DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX") lNum = lNum - (lNum Mod 10) If lNum Then DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman lNum = lNum - (lNum Mod 100) If lNum Then DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman End If End If End Function
De esta manera si es el 7 o el 46 (por ej) no sigue comprobando. Por cierto y RomanToDec() que? :silbar: :laugh: DoEvents! :P
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: Karcrack en 17 Diciembre 2010, 10:54 am
Lo importante es hacerlo corto, no rapido ni nada similar :P En cuanto a RomanToDec... no tiene utilidad :silbar: :xD
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: 79137913 en 17 Diciembre 2010, 14:41 pm
HOLA!!! Aunque no tenga utilidad, seguro alguien lo va a buscar y va a revivir el post asi que: RomanToDecimal: Private Function RomanToDecimal(RomNum As String) As String Dim VectorRom() As Integer 'Lo lleno con los valores de las letras Dim Tam As Integer 'Tamaño del numero Romano Dim X As Integer 'Para los Bucles Dim SumaRom As Integer 'Acumulador Tam = Len(RomNum) If Tam = 0 Then RomanToDecimal = 0 Exit Function End If ReDim VectorRom(1 To Tam) For X = 1 To Tam Select Case Mid$(RomNum, X, 1) Case "M": VectorRom(X) = 1000 Case "D": VectorRom(X) = 500 Case "C": VectorRom(X) = 100 Case "L": VectorRom(X) = 50 Case "X": VectorRom(X) = 10 Case "V": VectorRom(X) = 5 Case "I": VectorRom(X) = 1 End Select Next For X = 1 To Tam If X = Tam Then SumaRom = SumaRom + VectorRom(X) Else If VectorRom(X) >= VectorRom(X + 1) Then SumaRom = SumaRom + VectorRom(X) Else SumaRom = SumaRom - VectorRom(X) End If End If Next RomanToDecimal = CStr(SumaRom) End Function
GRACIAS POR LEER!!!
|