vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB6, VBA20.09.10
Arabische in römische Nummern umwandeln

Diese Funktion wandelt arabische Zahlen in römische Nummern um.

Autor:   Tobias KönigBewertung:  Views:  13.403 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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.



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.