Gruppe
UDF
Bereich
Zahlwort
Thema
Zahlwort englisch
Problem
Wie kann ich eine Zahl in englischer Sprache in Worten darstellen lassen?
Lösung
Geben Sie die nachfolgende benutzerdefinierte Funktion in ein Standardmodul ein.
StandardModule: basMain
Public Function ZWortEn(Number As Double)
Dim m As Double
m = Abs(Int(Number + 0.5))
m = Fix(Number)
Select Case m
Case Is < 100
ZWortEn = TextNum10(CInt(m))
Case Is < 1000
ZWortEn = TextNum100(CInt(m))
Case Is < 1000000
ZWortEn = TextNum1000(CInt(m))
Case Else
ZWortEn = TextNum1000000(CInt(m))
End Select
If Number < 0 Then ZWortEn = "minus " + ZWortEn
ZWortEn = UCase(Left(ZWortEn, 1)) + Mid(ZWortEn, 2)
End Function
Private Function TextNum10(n As Integer)
Select Case n
Case 0
TextNum10 = "zero"
Case Is < 20
TextNum10 = Einer(n)
Case Else
TextNum10 = Zweier(Int(n / 10))
If n <> Int(n / 10) * 10 Then TextNum10 = TextNum10 + "-" + _
Einer(n - Int(n / 10) * 10)
End Select
End Function
Private Function TextNum100(n As Integer)
Dim h#, x$
h = Int(n / 100)
x = TextNum10(n - h * 100)
If x = "zero" Then
TextNum100 = Einer(CInt(h)) + " hundred"
Else
TextNum100 = Einer(CInt(h)) + " hundred and " + x
End If
End Function
Private Function TextNum1000(n As Integer)
Dim k#
If n < 100000 Then
TextNum1000 = TextNum10(Int(n / 1000)) + " thousand "
Else
TextNum1000 = TextNum100(Int(n / 1000)) + " thousand "
End If
k = Int(n / 1000)
Select Case n - k * 1000
Case 0
TextNum1000 = TextNum1000
Case Is < 100
TextNum1000 = TextNum1000 + "and " + TextNum10(n - k * 1000)
Case Else
TextNum1000 = TextNum1000 + TextNum100(n - k * 1000)
End Select
End Function
Private Function TextNum1000000(n As Integer)
Dim k#
If n < 100000000 Then
TextNum1000000 = TextNum10(Int(n / 1000000)) + " million "
Else
TextNum1000000 = TextNum100(Int(n / 1000000)) + " million "
End If
k = Int(n / 1000000)
Select Case n - k * 1000000
Case 0
TextNum1000000 = TextNum1000000
Case Is < 100
TextNum1000000 = TextNum1000000 + "and " + TextNum10(n - k * 1000000)
Case Is < 1000
TextNum1000000 = TextNum1000000 + TextNum100(n - k * 1000000)
Case Else
TextNum1000000 = TextNum1000000 + TextNum1000(n - k * 1000000)
End Select
End Function
Private Function Einer(z As Integer) As String
Einer = WorksheetFunction.Choose(z, "one", "two", "three", "four", "five", _
"six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", _
"fourteen", "fifteen", "sexteen", "eighteen", "nineteen")
End Function
Private Function Zweier(z As Integer) As String
Zweier = WorksheetFunction.Choose(z - 1, "twenty", "thirty", _
"forty", "fifty", "sixty", "seventy", "eighty", "ninety")
End Function