AW: Zahl in Wort schreiben
03.02.2006 11:36:04
ray
Von Hans' CD:
Öffne mit Alt+F11 den VBA-Editor, gehe auf Einfügen > Modul und
kopiere diesn Code in das rechte Fenster.
Option Explicit
Function inWorten(wert As String) As String
Const Blöcke = 4
'max Anzahl von Dreierblöcken in einer Zahl (z.B. 4 = max bis 999 999 999 999)
Dim Block$(Blöcke)
Dim text$(Blöcke)
Dim Gruppe$(Blöcke)
Dim GrEndSg$(Blöcke)
Dim GrEndPl$(Blöcke)
Dim Einer$(10)
Dim Einer2$(10)
Dim i%, pos%
Dim nk$, TextG$
Dim neg As String
If wert < 0 Then
neg = "minus "
wert = Right(wert, Len(wert) - 1)
End If
Einer$(0) = ""
Einer$(1) = "eins"
Einer$(2) = "zwei"
Einer$(3) = "drei"
Einer$(4) = "vier"
Einer$(5) = "fünf"
Einer$(6) = "sechs"
Einer$(7) = "sieben"
Einer$(8) = "acht"
Einer$(9) = "neun"
Einer2$(0) = ""
Einer2$(1) = "ein"
Einer2$(2) = "zwei"
Einer2$(3) = "drei"
Einer2$(4) = "vier"
Einer2$(5) = "fünf"
Einer2$(6) = "sech"
Einer2$(7) = "sieb"
Einer2$(8) = "acht"
Einer2$(9) = "neun"
Gruppe$(1) = ""
Gruppe$(2) = "tausend"
Gruppe$(3) = "million"
Gruppe$(4) = "milliarde"
' Gruppenendung Singular
GrEndSg$(1) = ""
GrEndSg$(2) = ""
GrEndSg$(3) = ""
GrEndSg$(4) = ""
' Gruppenendung Plural
GrEndPl$(1) = ""
GrEndPl$(2) = ""
GrEndPl$(3) = "en"
GrEndPl$(4) = "n"
For i = 1 To Blöcke
Block$(i) = ""
text$(i) = ""
Next
'* Alle Punkte entfernen
pos = InStr(wert$, ".")
While pos > 0
wert$ = Left$(wert$, pos - 1) + Right$(wert$, Len(wert$) - pos)
pos = InStr(pos, wert$, ".")
Wend
'* Nachkommastellen NK$ schreiben
pos = InStr(wert$, ",")
If pos > 0 Then
nk$ = Right$(wert$, Len(wert$) - pos)
wert$ = Left$(wert$, pos - 1)
Else
nk$ = ""
End If
For i = 1 To Blöcke
If Len(wert$) > 3 Then
Block$(i) = Right$(wert$, 3)
wert$ = Left$(wert$, Len(wert$) - 3)
Else
Block$(i) = wert$
wert$ = ""
End If
If Block$(i) <> "" Then
If Len(Block$(i)) = 3 Then
If Block$(i) = "000" Then
text$(i) = ""
ElseIf Left$(Block$(i), 1) = "1" Then
text$(i) = "einhundert"
ElseIf Left$(Block$(i), 1) = "0" Then
text$(i) = ""
Else
text$(i) = text$(i) + Einer$(Val(Left$(Block$(i), 1))) + "hundert"
End If
Block$(i) = Right$(Block$(i), 2)
End If
If Len(Block$(i)) = 2 Then
If Left$(Block$(i), 1) = "0" Then
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
ElseIf Left$(Block$(i), 1) = "1" Then
If Left$(Block$(i), 2) = "11" Then
text$(i) = text$(i) + "elf"
ElseIf Left$(Block$(i), 2) = "12" Then
text$(i) = text$(i) + "zwölf"
Else
text$(i) = text$(i) + Einer2$(Val(Right$(Block$(i), 1))) + "zehn"
End If
ElseIf Left$(Block$(i), 1) = "2" Then
If Left$(Block$(i), 2) = "21" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Left$(Block$(i), 2) <> "20" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + "zwanzig"
ElseIf Left$(Block$(i), 1) = "3" Then
If Left$(Block$(i), 2) = "31" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Left$(Block$(i), 2) <> "30" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + "dreißig"
Else
If Right$(Block$(i), 1) = "1" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Right$(Block$(i), 1) <> "0" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + Einer2$(Val(Left$(Block$(i), 1))) + "zig"
End If
End If
If Len(Block$(i)) = 1 Then
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
End If
If text$(i) <> "" Then
End If
Next
For i = Blöcke To 1 Step -1
If text$(i) <> "" Then
If text$(i) = "eins" Then
If i > 2 Then
text$(i) = "eine"
ElseIf i = 2 Then
text$(i) = "ein"
End If
text$(i) = text$(i) + Gruppe$(i)
text$(i) = text$(i) + GrEndSg$(i)
Else
text$(i) = text$(i) + Gruppe$(i)
text$(i) = text$(i) + GrEndPl$(i)
End If
End If
TextG$ = TextG$ + text$(i)
Next
If TextG$ = "" Then
TextG$ = " "
End If
If (nk$ <> "") And (nk$ <> "0") And (nk$ <> "00") Then
If Len(nk$) = 1 Then
nk$ = nk$ + "0"
End If
TextG$ = "( in Worten: " + TextG$ + " und " + nk$ + "/100 Euro )"
End If
If Right$(TextG$, 1) = ")" Then
TextG$ = Left$(TextG$, 13) + Chr$(Asc(Mid$(TextG$, 14, 1)) - 32) + Right$(TextG$, Len(TextG$) - 14)
Else
TextG$ = Chr$(Asc(Left$(TextG$, 1)) - 32) + Right$(TextG$, Len(TextG$) - 1)
End If
inWorten = neg & TextG$
End Function
Function inWorten2(wert As String) As String
Const Blöcke = 4
'max Anzahl von Dreierblöcken in einer Zahl (z.B. 4 = max bis 999 999 999 999)
Dim Block$(Blöcke)
Dim text$(Blöcke)
Dim Gruppe$(Blöcke)
Dim GrEndSg$(Blöcke)
Dim GrEndPl$(Blöcke)
Dim Einer$(10)
Dim Einer2$(10)
Dim i%, pos%
Dim nk$, TextG$
Dim neg As String
If wert < 0 Then
neg = "minus "
wert = Right(wert, Len(wert) - 1)
End If
Einer$(0) = ""
Einer$(1) = "eins"
Einer$(2) = "zwei"
Einer$(3) = "drei"
Einer$(4) = "vier"
Einer$(5) = "fünf"
Einer$(6) = "sechs"
Einer$(7) = "sieben"
Einer$(8) = "acht"
Einer$(9) = "neun"
Einer2$(0) = ""
Einer2$(1) = "ein"
Einer2$(2) = "zwei"
Einer2$(3) = "drei"
Einer2$(4) = "vier"
Einer2$(5) = "fünf"
Einer2$(6) = "sech"
Einer2$(7) = "sieb"
Einer2$(8) = "acht"
Einer2$(9) = "neun"
Gruppe$(1) = ""
Gruppe$(2) = "tausend"
Gruppe$(3) = "million"
Gruppe$(4) = "milliarde"
' Gruppenendung Singular
GrEndSg$(1) = ""
GrEndSg$(2) = ""
GrEndSg$(3) = ""
GrEndSg$(4) = ""
' Gruppenendung Plural
GrEndPl$(1) = ""
GrEndPl$(2) = ""
GrEndPl$(3) = "en"
GrEndPl$(4) = "n"
For i = 1 To Blöcke
Block$(i) = ""
text$(i) = ""
Next
'* Alle Punkte entfernen
pos = InStr(wert$, ".")
While pos > 0
wert$ = Left$(wert$, pos - 1) + Right$(wert$, Len(wert$) - pos)
pos = InStr(pos, wert$, ".")
Wend
'* Nachkommastellen NK$ schreiben
pos = InStr(wert$, ",")
If pos > 0 Then
nk$ = Right$(wert$, Len(wert$) - pos)
wert$ = Left$(wert$, pos - 1)
Else
nk$ = ""
End If
For i = 1 To Blöcke
If Len(wert$) > 3 Then
Block$(i) = Right$(wert$, 3)
wert$ = Left$(wert$, Len(wert$) - 3)
Else
Block$(i) = wert$
wert$ = ""
End If
If Block$(i) <> "" Then
If Len(Block$(i)) = 3 Then
If Block$(i) = "000" Then
text$(i) = ""
ElseIf Left$(Block$(i), 1) = "1" Then
text$(i) = "einhundert"
ElseIf Left$(Block$(i), 1) = "0" Then
text$(i) = ""
Else
text$(i) = text$(i) + Einer$(Val(Left$(Block$(i), 1))) + "hundert"
End If
Block$(i) = Right$(Block$(i), 2)
End If
If Len(Block$(i)) = 2 Then
If Left$(Block$(i), 1) = "0" Then
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
ElseIf Left$(Block$(i), 1) = "1" Then
If Left$(Block$(i), 2) = "11" Then
text$(i) = text$(i) + "elf"
ElseIf Left$(Block$(i), 2) = "12" Then
text$(i) = text$(i) + "zwölf"
Else
text$(i) = text$(i) + Einer2$(Val(Right$(Block$(i), 1))) + "zehn"
End If
ElseIf Left$(Block$(i), 1) = "2" Then
If Left$(Block$(i), 2) = "21" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Left$(Block$(i), 2) <> "20" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + "zwanzig"
ElseIf Left$(Block$(i), 1) = "3" Then
If Left$(Block$(i), 2) = "31" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Left$(Block$(i), 2) <> "30" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + "dreißig"
Else
If Right$(Block$(i), 1) = "1" Then
text$(i) = text$(i) + "ein"
Else
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
If Right$(Block$(i), 1) <> "0" Then
text$(i) = text$(i) + "und"
End If
text$(i) = text$(i) + Einer2$(Val(Left$(Block$(i), 1))) + "zig"
End If
End If
If Len(Block$(i)) = 1 Then
text$(i) = text$(i) + Einer$(Val(Right$(Block$(i), 1)))
End If
End If
If text$(i) <> "" Then
End If
Next
For i = Blöcke To 1 Step -1
If text$(i) <> "" Then
If text$(i) = "eins" Then
If i > 2 Then
text$(i) = "eine"
ElseIf i = 2 Then
text$(i) = "ein"
End If
text$(i) = text$(i) + Gruppe$(i)
text$(i) = text$(i) + GrEndSg$(i)
Else
text$(i) = text$(i) + Gruppe$(i)
text$(i) = text$(i) + GrEndPl$(i)
End If
End If
TextG$ = TextG$ + text$(i)
Next
If TextG$ = "" Then
TextG$ = " "
End If
If (nk$ <> "") And (nk$ <> "0") And (nk$ <> "00") Then
If Len(nk$) = 1 Then
nk$ = nk$ + "0"
End If
TextG$ = "( in Worten: " + TextG$ + " Komma " + inWorten2(nk$) + ")"
End If
If Right$(TextG$, 1) = ")" Then
TextG$ = Left$(TextG$, 13) + Chr$(Asc(Mid$(TextG$, 14, 1)) - 32) + Right$(TextG$, Len(TextG$) - 14)
Else
TextG$ = Chr$(Asc(Left$(TextG$, 1)) - 32) + Right$(TextG$, Len(TextG$) - 1)
End If
inWorten2 = neg & TextG$
End
Function
In der Tabelle nutzt du das als ganz normale Formel. "=InWorten(A1)" bzw. "=InWorten2(A1)"