wimgielis.com

Romeins → Arabisch

• 20/05/2007

	Voorbeeldbestanden bij dit artikel:
		Romeins - Arabisch
	Romeins - Arabisch

Inleiding

Om deze opdracht tot een goed einde te brengen, dacht ik initieel code nodig te hebben om een getal in Romeinse cijfers naar gewone (Arabische) cijfers om te zetten. Nu, Arabische cijfers omzetten naar Romeinse cijfers is niet moeilijk, de functie ROMEINS doet dit in Excel voor jou. Het omgekeerde is echter standaard niet mogelijk in Excel. Ik schreef dan maar zelf code daarvoor.

Uiteindelijk bleek ik de code toch niet nodig te hebben, aangezien ik de oplossing anders aanpakte. Ik kan mij ook al eens vergissen, zie je… Ten behoeve van het algemeen belang blijf op deze pagina toch nog de code staan, voor in het geval iemand ze toch ooit nodig mocht hebben.

VBA-code

Function RomanToArabic(sRoman As String) As String
' Wim Gielis
' https://www.wimgielis.com
'''''
' Custom function to convert numbers in Roman notation
' to Arabic counterparts
' 12/01/07
'''''
Dim iFirstLetterArabic As Integer
Dim iSecondLetterArabic As Integer
Dim i As Integer

Application.Volatile

sRoman = UCase(Trim(sRoman))

If IsNumeric(sRoman) Then
    RomanToArabic = "Please enter a roman number"
    Exit Function
End If

'are there any "non-Roman" characters
For i = 1 To Len(sRoman)

    Select Case Mid(sRoman, i, 1)

        Case "I", "V", "X", "L", "C", "D", "M"

        Case Else
            RomanToArabic = sRoman & " has ""non-Roman"" characters in it"
            Exit Function

    End Select
Next i

Select Case Len(sRoman)

    Case 0
        Exit Function

    Case 1
        RomanToArabic = RomanToArabic + sBasicRoman(sRoman)

    Case Else:
        iFirstLetterArabic = sBasicRoman(Mid(sRoman, 1, 1))
        iSecondLetterArabic = sBasicRoman(Mid(sRoman, 2, 1))

        If iFirstLetterArabic < iSecondLetterArabic Then

            RomanToArabic = RomanToArabic + (iSecondLetterArabic - iFirstLetterArabic)

            sRoman = IIf(Len(sRoman) = 2, "", Mid(sRoman, 3))

            RomanToArabic = RomanToArabic + RomanToArabic(sRoman)
        Else

            RomanToArabic = RomanToArabic + iFirstLetterArabic

            RomanToArabic = RomanToArabic + RomanToArabic(Mid(sRoman, 2))
        End If

    End Select
End Function

Function sBasicRoman(sRoman As String) As Integer
	Select Case sRoman
		Case "I": sBasicRoman = 1
		Case "V": sBasicRoman = 5
		Case "X": sBasicRoman = 10
		Case "L": sBasicRoman = 50
		Case "C": sBasicRoman = 100
		Case "D": sBasicRoman = 500
		Case "M": sBasicRoman = 1000
	End Select
End Function

Gebruik van de functie

Hoe werkt het? Open de VBA editor door in Excel te kiezen voor Extra > Macro > Visual Basic Editor (of Alt + F11 te drukken). Doe dan Insert > Module en plak de code die hierboven staat. Sluit het venster. Typ dan in een cel, bv. A1, het Romeinse getal. In een andere cel, zet je:

=RomanToArabic(A1)

en druk op Enter. Het resultaat zou er dan moeten staan. Klopt het? Neem de proef op de som door in nog een andere cel

=ROMEINS(A2)

te zetten. (Verander A2 als je een andere cel gebruikt hebt.) Je moet het oorspronkelijke Romeinse getal uitkomen. De functie

=RomanToArabic()

is nu overal in je bestand bruikbaar.

• « Vorig Excel artikel
• Volgend Excel artikel »