Hallo,
gibt es in Excel eine Funktion, die Zahlen in ausgeschriebenen Text umwandeln kann? Z.B. 100 = einhundert
Vorab vielen Dank
Office - Word, Excel und Co. 9.738 Themen, 41.366 Beiträge
Fetzo1 Mark40 „Excel: Zahlen in ausgeschriebenen Text umwandeln“
Hallo den folgenden Code habe ich irgendwo im Netz gefunden und leicht modifiziert.
Er liefert eine Funktion, die man im Funktionsassistenten unter "benutzerdefinierte Funktionen" findet und die ZAHLTEXT() heißt.
Vielleicht langt das ja...
Gruß Fetzo
Function zahltext(Number)
Dim zstring As String
Dim s(12)
zstring = Application.WorksheetFunction.Round(Number, 2)
If Len(zstring) > 12 Then
zahltext = "#Fehler:Zu viele Stellen"
Exit Function
End If
For z1 = 1 To Len(zstring)
If Mid$(zstring, z1, 1) = "," Then
nachkomma = Right$(zstring, Len(zstring) - z1)
If Len(nachkomma) = 1 Then nachkomma = nachkomma & "0"
zstring = Left$(zstring, z1 - 1)
Exit For
End If
Next z1
' Initialisieren
For I = 1 To 12
s(I) = "0"
Next
' Zahl in Ziffern splitten
I = 1
While Len(zstring) > 0
s(I) = (Right(zstring, 1))
zstring = Left(zstring, (Len(zstring) - 1))
I = I + 1
Wend
' Textfolge zusammensetzen
zstring = ""
' XXHundert-Milliarden
If (s(12) "0") Then
merkezahl = CSng(s(12))
zz = MacheText1(merkezahl)
zstring = zstring + zz + "hundert"
If (s(11) = "0" And s(10) = "0") Then zstring = zstring + "milliarden"
End If
' XXZehn-Milliarden
If (s(11) "0") Then
merkezahl = CSng(s(11))
merkezahl2 = CSng(s(10))
zz = (machetext3(merkezahl, merkezahl2))
zstring = zstring + zz + "milliarden"
End If
' Millionen
If (s(11) = 0 And s(10) "0") Then
merkezahl = CSng(s(10))
zz = MacheText1(merkezahl)
If merkezahl = 1 Then zz = "eine"
zstring = zstring + zz + "milliarden"
End If
' XXHundert-Millionen
If (s(9) "0") Then
merkezahl = CSng(s(9))
zz = MacheText1(merkezahl)
zstring = zstring + zz + "hundert"
If (s(8) = "0" And s(7) = "0") Then zstring = zstring + "millionen"
End If
' XXZehn-Millionen
If (s(8) "0") Then
merkezahl = CSng(s(8))
merkezahl2 = CSng(s(7))
zz = (machetext3(merkezahl, merkezahl2))
zstring = zstring + zz + "millionen"
End If
' Millionen
If (s(8) = 0 And s(7) "0") Then
merkezahl = CSng(s(7))
zz = MacheText1(merkezahl)
If merkezahl = 1 Then zz = "eine"
zstring = zstring + zz + "millionen"
End If
' XXHundert-Tausend
If (s(6) "0") Then
merkezahl = CSng(s(6))
zz = MacheText1(merkezahl)
zstring = zstring + zz + "hundert"
If (s(5) = "0" And s(4) = "0") Then zstring = zstring + "tausend"
End If
' XXZehn-Tausend
If (s(5) "0") Then
merkezahl = CSng(s(5))
merkezahl2 = CSng(s(4))
zz = (machetext3(merkezahl, merkezahl2))
zstring = zstring + zz + "tausend"
End If
' Tausend
If (s(5) = 0 And s(4) "0") Then
merkezahl = CSng(s(4))
zz = MacheText1(merkezahl)
zstring = zstring + zz + "tausend"
End If
' Hundert
If (s(3) "0") Then
merkezahl = CSng(s(3))
zz = MacheText1(merkezahl)
zstring = zstring + zz + "hundert"
End If
' Zehn
If (s(2) "0") Then
merkezahl = CSng(s(2))
merkezahl2 = CSng(s(1))
zstring = zstring + (machetext3(merkezahl, merkezahl2))
End If
' Einer
If (s(2) = 0 And s(1) "0") Then
merkezahl = CSng(s(1))
zz = MacheText1(merkezahl)
If merkezahl = 1 Then zz = "eine" ' Für DM = eine, ggfs. ändern !
zstring = zstring + zz
End If
' Erste Ziffer als Versalie
zahltext = UCase(Left(zstring, 1)) + Right(zstring, (Len(zstring) - 1))
zahltext = zahltext & " " & nachkomma & "/100"
End Function
Private Function MacheText1(ziffer)
' Einer-Ziffern als Text
MacheText1 = ""
Select Case ziffer
Case 1
MacheText1 = "ein"
Case 2
MacheText1 = "zwei"
Case 3
MacheText1 = "drei"
Case 4
MacheText1 = "vier"
Case 5
MacheText1 = "fünf"
Case 6
MacheText1 = "sechs"
Case 7
MacheText1 = "sieben"
Case 8
MacheText1 = "acht"
Case 9
MacheText1 = "neun"
End Select
End Function
Private Function MacheText2(ziffer)
' Zehner-Ziffer
Select Case ziffer
Case 1
MacheText2 = "zehn"
Case 2
MacheText2 = "zwanzig"
Case 3
MacheText2 = "dreißig"
Case 4
MacheText2 = "vierzig"
Case 5
MacheText2 = "fünfzig"
Case 6
MacheText2 = "sechzig"
Case 7
MacheText2 = "siebzig"
Case 8
MacheText2 = "achtzig"
Case 9
MacheText2 = "neunzig"
End Select
End Function
Private Function machetext3(ziffer1, ziffer2)
' Zehnerziffer mit Einerziffer
machetext3 = ""
If ziffer2 = 0 Then
machetext3 = MacheText2(ziffer1)
Else
'
If ziffer1 = 1 Then
zz2 = (MacheText1(ziffer2))
Select Case ziffer2
Case 1
machetext3 = "elf"
Case 2
machetext3 = "zwölf"
Case Else
machetext3 = zz2 + "zehn"
End Select
Else
zz1 = MacheText2(ziffer1)
zz2 = MacheText1(ziffer2)
machetext3 = zz2 + "und" + zz1
End If
End If
End Function
