LatinToRoman

VBScriptCopia

Option Explicit

'Converte un numero in numero romano es. 14 = XIV
Function LatinToRoman(ByVal number As Integer) As String
    
    Dim i As Integer
    Dim n(1 To 7) As Integer
    Dim d(1 To 7) As Integer
    Dim v(1 To 7) As String * 1
    Dim roman As String

    n(1) = 1: d(1) = 0: v(1) = "I"
    n(2) = 5: d(2) = 1: v(2) = "V"
    n(3) = 10: d(3) = 1: v(3) = "X"
    n(4) = 50: d(4) = 3: v(4) = "L"
    n(5) = 100: d(5) = 3: v(5) = "C"
    n(6) = 500: d(6) = 5: v(6) = "D"
    n(7) = 1000: d(7) = 5: v(7) = "M"
    
    For i = 7 To 1 Step -1
        Do While number >= n(i)
                roman = roman & v(i)
                number = number - n(i)
        Loop
        If i > 1 Then
            If number >= n(i) - n(d(i)) Then
                roman = roman & v(d(i)) & v(i)
                number = number - (n(i) - n(d(i)))
            End If
        End If
    Next i
    
    LatinToRoman = roman
End Function