|
Die Darstellung von Zahlen als römische Zahlen ist zwar
heutzutage nicht mehr sonderlich aktuell. Dennoch wird sie hin und
wieder noch gebraucht, etwa zur Darstellung von Jahreszahlen oder
zur Nummerierung von Kapiteln oder Absätzen in Büchern oder
juristischen Schriftsätzen. Für diese Zwecke mag auch der
Wertebereich, der sich in römischen Zahlen darstellen lässt,
vollauf ausreichend sein - er reicht nur von 1 bis
3999. Die Handicaps der römischen Zahlen sind nämlich, dass
erstens 1000 der höchste durch ein einzelnes
Zahlzeichen darstellbare Wert ist, und zweitens die fundamentale
Regel, dass nicht mehr als drei gleiche Zeichen aufeinander folgen
dürfen. Sie können natürlich letztere Regel einfach ignorieren,
wenn Ihnen danach sein sollte - nur würde man solche Zeichengebilde
kaum mehr als römische Zahlen betrachten können, sondern sie eher
als "komische Zahlen" empfinden...
Die Funktion NumToRoman wandelt eine Integer-Zahl im Bereich von
1 bis 3999 in eine römische Zahl um. Werte
außerhalb dieses Bereichs werden mit einem im aufrufenden Code
abfangbaren Laufzeitfehler (romanErrOutOfRange) quittiert.
Umgekehrt konvertiert die Funktion RomanToNum die Zeichenfolge
einer römischen Zahl in eine Integer-Zahl. Ihr können die Zeichen
der römischen Zahl in Groß- oder Kleinschreibung übergeben
werden. Enthält die Zeichenfolge ungültige Zeichen, wird der
abfangbare Laufzeitfehler romanErrInvalidRomanDigit ausgelöst.
Public Const romanErrOutOfRange = 1
Public Const romanErrInvalidRomanDigit = 2
Public Function NumToRoman(ByVal Number As Integer) As String
Dim i As Integer
Dim nDigitValue As Integer
Dim nRoman As String
Dim nDigits(1 To 7)
Select Case Number
Case 1 To 3999
Case Else
Err.Raise romanErrOutOfRange, "modRomanNumbers.NumToRoman", _
"Wert außerhalb des Bereichs 1 bis 3999"
Exit Function
End Select
nDigits(1) = "I"
nDigits(2) = "V"
nDigits(3) = "X"
nDigits(4) = "L"
nDigits(5) = "C"
nDigits(6) = "D"
nDigits(7) = "M"
i = 1
Do While Number > 0
nDigitValue = Number Mod 10
Select Case nDigitValue
Case 1
nRoman = nDigits(i) & nRoman
Case 2
nRoman = nDigits(i) & nDigits(i) & nRoman
Case 3
nRoman = nDigits(i) & nDigits(i) & nDigits(i) & nRoman
Case 4
nRoman = nDigits(i) & nDigits(i + 1) & nRoman
Case 5
nRoman = nDigits(i + 1) & nRoman
Case 6
nRoman = nDigits(i + 1) & nDigits(i) & nRoman
Case 7
nRoman = nDigits(i + 1) & nDigits(i) & nDigits(i) & nRoman
Case 8
nRoman = nDigits(i + 1) & nDigits(i) & nDigits(i) & _
nDigits(i) & nRoman
Case 9
nRoman = nDigits(i) & nDigits(i + 2) & nRoman
End Select
i = i + 2
Number = Number \ 10
Loop
NumToRoman = nRoman
End Function
Public Function RomanToNum(Roman As String) As Integer
Dim nRoman As String
Dim i As Integer
Dim nRomanDigitValue As Integer
Dim nRomanDigitValue2 As Integer
Dim nNumber As Integer
Dim nDigits As Collection
Dim nTempValue As Integer
Set nDigits = New Collection
With nDigits
.Add 1, "I"
.Add 5, "V"
.Add 10, "X"
.Add 50, "L"
.Add 100, "C"
.Add 500, "D"
.Add 1000, "M"
End With
nRoman = UCase$(Roman)
On Error GoTo RomanToNum_Error
For i = 1 To Len(nRoman) - 1
nRomanDigitValue = nDigits(Mid$(nRoman, i, 1))
nRomanDigitValue2 = nDigits(Mid$(nRoman, i + 1, 1))
If nRomanDigitValue < nRomanDigitValue2 Then
nTempValue = nTempValue + nRomanDigitValue
Else
If nTempValue Then
nNumber = nNumber + (nRomanDigitValue - nTempValue)
nTempValue = 0
Else
nNumber = nNumber + nRomanDigitValue
End If
End If
Next 'i
If nTempValue Then
nNumber = nNumber + (nDigits(Mid$(nRoman, Len(nRoman), 1)) _
- nTempValue)
Else
nNumber = nNumber + nDigits(Mid$(nRoman, Len(nRoman), 1))
End If
RomanToNum = nNumber
Exit Function
RomanToNum_Error:
Err.Raise romanErrInvalidRomanDigit, "modRomanNumbers.RomanToNum", _
"Römische Zahl enthält ungültige Zeichen"
End Function
 |
Die Funktionen NumToRoman konvertiert eine
Integer-Zahl in eine römische Zahl, die Funktion RomanToNum
eine römische Zahl in eine Integer-Zahl
|
|