|
Hallo,
Google liefert folgendes Ergebnis:
Public Function fktRoman(ByVal Arab As Long) As String
Dim Arabisch As Variant, Roemisch As Variant, _
Roem As String, I As Long
Arabisch = Array(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000)
Roemisch = Array("I", "IV", "V", "IX", "X", "XL", "L", "XC", _
"C", "CD", "D", "CM", "M")
For I = UBound(Arabisch) To LBound(Arabisch) Step -1
Do While Arab >= Arabisch(I)
Arab = Arab - Arabisch(I)
Roem = Roem + Roemisch(I)
Loop
Next I
fktRoman = Roem
End Function
Gruß
|