Zahlen in Worte Excel VBA
05.03.2020 14:36:10
Simone
ich möchte "nur" Zahlen in Worte ausgespielt bekommen, mit einer Kommastelle. Nach etwas Googeln habe ich bereits folgendes VBA Makro gefunden:
Dim i%
Function ZWort(Zahl As Double) As String
Dim Teil1$, ATeil$, BTeil$, Rest$
If Fix(Zahl) = 0 Then
If Zahl = 0 Then
ZWort = "null"
Exit Function
Else
ZWort = Format((Zahl - Fix(Zahl)))
Exit Function
End If
End If
If Zahl = Fix(Zahl) Then
Rest = ""
Else
Rest = " " & Format((Zahl - Fix(Zahl)))
End If
If Zahl = 0 Then ZWort = "null": Exit Function
Zahl = Fix(Zahl)
If Zahl = 1 Then ZWort = "eins" & Rest: Exit Function
i = 0
ATeil = Right(Zahl, 3)
ZWort = Hunderter(ATeil)
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If ZWort > "" Then ZWort = ZWort & "tausend"
ZWort = ZWort & Teil1
If Right(ATeil, 3) = 1 Then ZWort = ZWort & "s"
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "million" & Teil1
Else
If ZWort > "" Then ZWort = ZWort & "millionen"
ZWort = ZWort & Teil1
End If
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "milliarde" & Teil1
Else
ZWort = ZWort & "milliarden" & Teil1
End If
Beenden:
ZWort = ZWort & Rest
End Function
Private Function Hunderter(Hteil)
Dim eZahl%, Ziffer1$, Ziffer2$, Ziffer3$
eZahl = Right(Hteil, 1)
Hunderter = Einer(eZahl)
Ziffer3 = Hunderter
If Hteil "" Then
Hunderter = Hunderter & "und" & Zehner1(eZahl)
Else
Hunderter = Zehner1(eZahl)
Ziffer1 = Hunderter
End If
If Hteil 9 And Right(Hteil, 2) Private Function Einer(EinerZahl)
Select Case EinerZahl
Case Is = 1
Einer = "ein"
Case Is = 2
Einer = "zwei"
Case Is = 3
Einer = "drei"
Case Is = 4
Einer = "vier"
Case Is = 5
Einer = "fünf"
Case Is = 6
Einer = "sechs"
Case Is = 7
Einer = "sieben"
Case Is = 8
Einer = "acht"
Case Is = 9
Einer = "neun"
End Select
End Function
Private Function Zehner(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 10
Zehner = "zehn"
Case Is = 11
Zehner = "elf"
Case Is = 12
Zehner = "zwölf"
Case Is = 13
Zehner = "dreizehn"
Case Is = 14
Zehner = "vierzehn"
Case Is = 15
Zehner = "fünfzehn"
Case Is = 16
Zehner = "sechzehn"
Case Is = 17
Zehner = "siebzehn"
Case Is = 18
Zehner = "achtzehn"
Case Is = 19
Zehner = "neunzehn"
End Select
End Function
Private Function Zehner1(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 2
Zehner1 = "zwanzig"
Case Is = 3
Zehner1 = "dreißig"
Case Is = 4
Zehner1 = "vierzig"
Case Is = 5
Zehner1 = "fünfzig"
Case Is = 6
Zehner1 = "sechzig"
Case Is = 7
Zehner1 = "siebzig"
Case Is = 8
Zehner1 = "achtzig"
Case Is = 9
Zehner1 = "neunzig"
End Select
End Function
Das Makro enthält jedoch noch Angaben, die meine Zahlen zwar als Wort jedoch mit falschem Zusatz der Nachkommstellen anzeigen. Nachkommastellen sollten einfach als Text erscheinen bzw. die Frage wäre auch wie ich den Befehl geben kann, die Nachkommastellen auszublenden.
Vielen Dank schon vorab!
Viele Grüße
Simone