|
Hallo,
-
Excel öffnen
-
Alt+F11
-
Alt+E
-
Alt+M
-
folgenden Code einfügen:
Option Explicit
Public Sub convert()
Dim sInput As String
sInput = InputBox("Bitte geben Sie eine Zahl ein:")
If Not IsNumeric(sInput) Then
MsgBox "Das war keine Zahl..", vbExclamation
Exit Sub
End If
MsgBox "Arabisch: " & sInput & vbCrLf & _
"Römisch: " & fktRoman(sInput), vbInformation
End Sub
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
VBA Editor schließen und dann in Excel unter Entwicklertools das Makro "convert" aufrufen.
Gruß
|