Arabische in römische Nummern umwandeln Diese Funktion wandelt arabische Zahlen in römische Nummern um.
Autor:   Tobias König	Bewertung:     [ Jetzt bewerten ]	Views:  13.598
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 7 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.6 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgender Funktion lassen sich arabische Zahlen in römische Darstellung umwandeln.

' Design by Tobias König, Dresden
' Bei Gross = False wird die Römische Ziffer komplett klein geschrieben
Function RömischeNummerErmitteln(ByVal Nummer As Integer, _
  Optional ByVal Gross As Boolean = True) As String
 
  If Nummer = 0 Then Exit Function
 
  Dim j As Byte, k As Byte, d As Byte
  Dim Pa As String, RN As String
  Dim RZ As Variant
  Dim Beginn As Long
 
  ' vierstellige Zahl erstellen
  Dim Digit(4) As Integer
  Pa = Format(Nummer, "0000")
  For j = 1 To 4
    Digit(j) = Mid(Pa, j, 1)
  Next
 
  Select Case Digit(1)
    Case Is <> 0
      For k = 1 To Digit(1)
        RN = RN + "M"
      Next k
  End Select
 
  RZ = Array("M", "D", "C", "L", "X", "V", "I")
  For d = 2 To 4
    Beginn = d * 2 - 4
    Select Case Digit(d)
      Case 1, 2, 3
        For k = 1 To Digit(d)
          RN = RN + RZ(Beginn + 2)
        Next k
      Case 4
        RN = RN + RZ(Beginn + 2)
      Case 5
        RN = RN + RZ(Beginn + 1)
      Case 6, 7, 8
        RN = RN + RZ(Beginn + 2)
        For k = 1 To Digit(d) - 5
          RN = RN + RZ(Beginn + 2)
        Next k
      Case 9
        RN = RN + RZ(Beginn + 2) + RZ(Beginn)
    End Select
  Next d
 
  If Not Gross Then RN = LCase$(RN)
 
  RömischeNummerErmitteln = RN
End Function

Anmerkung:
Die Idee zu dieser Funktion stammt eigentlich von Rene Probst und seiner WordFaq. Diese habe ich jedoch verbessert durch die d-Schleife.