Zahl in Worten
Hallo Harry,
Erstmal sorry… In meinem übermut die manieren ganz vergessen
Schön1, so ist’s doch netter *find*
Also ich möchte auf einem anderen Tabellenblatt mittels dieser
Formel ein paar hundert Zahlen auschreiben lassen und in der
Zelle daneben stehen haben. (für einen Serienbrief)
Schön2, so kapiere ich das auch 
[url=[http://www.abload.de/image.php?img=unbenanntd1rk7.pn…](http://www.abload.de/image.php?img=unbenanntd1rk7.png][img=http://www.abload.de/thumb/unbenanntd1rk7.png][/url)]
Du hast dir also dort den ersten Download/Mappe runtergeladen:
http://www.excelformeln.de/tips.html?welcher=36
Markus ist in Word Sonderklasse also schau dir unbedingt da diesen
Feldschalter genauestens an.
Tipp, in der Brettbeschreibung vom Wordbrett ist ein Link,
suche da mal nach so Schaltern bzw. Zahl in Worten.
Was da nun auf dem Hillfsblatt von Makus stehen soll weiß ich grad
nicht und weiß auch nicht wie man das was du willst in Excel angehen
könnte mit Formeln ohne die groß neu zuschreiben oder laufend
anzupassen.
Ging auch Vba?
Dann könntest du nachfolgenden Code in ein Add-Inn packen oder auch
in die persönliche Arbeitsmappe.
Letzteres habe ich jetzt mal für XL 2000 getan. Das sieht dann so aus:
Tabellenblatt: [Mappe1]!Tabelle1
│ A │ B │
──┼──────────┼──────────────────────────────────────────────────────────────────────────┤
1 │ 24569708 │ vierundzwanzigmillionenfünfhundertneunundsechzigtausendsiebenhundertacht │
──┴──────────┴──────────────────────────────────────────────────────────────────────────┘
Benutzte Formeln:
B1: =PERSONL.XLS!getZahl\_in\_Worten(A1)
A1:B1
haben das Zahlenformat: Standard
Kommastellen fehen noch, nja müßte man noch einbauen wenn nötig.
Quelle des VB-Codes:
http://www.activevb.de/tipps/vb6tipps/tipp0551.html
Gruß
Reinhard
In Standardmodul, z.B. Modul1
Option Explicit
Private curHunderter As Integer
Private curTausender As Integer
Private curMillionen As Integer
'
' erzeugt Zahlenstring und schreibt ihn in Label1
'
Private Sub Command1\_Click()
If CDbl(Text1) "
Label1.Refresh
End If
Timer1.Enabled = True
End Sub
'
' erlaubt nur die eingabe von Zahlen in Textfeld
'
Sub Text1\_Change()
If Not IsNumeric(Text1.Text) Then
Beep
Text1.Text = ""
End If
End Sub
'
' erzeugt eine Zufallszahl, die in Text1 geschrieben wird
'
'Private Sub Timer1\_Timer()
' Timer1.Enabled = False
'
' Text1.Text = Int((999999999 - 0 + 1) \* Rnd + 0)
'End Sub
'
' Hauptfunktion zum umwandeln einer Zahl in Worte
'
Public Function getZahl\_in\_Worten(curZahl As Long) As String
Dim tmpTausender As String, tmpMillionen As String
Dim tmpHunderter As String
Select Case curZahl
Case Is \> 999999999
getZahl\_in\_Worten = ""
Case Is \> 1000000
curMillionen = CInt(Left(CStr(curZahl), Len(CStr(curZahl)) - 6))
tmpTausender = Left(CStr(curZahl), Len(CStr(curZahl)) - 3)
curTausender = CInt(Right(tmpTausender, 3))
tmpTausender = ""
curHunderter = CInt(Right(CStr(curZahl), 3))
'Zehnmillionen ermitteln
tmpMillionen = getZehner(CInt(Right(CStr(curMillionen), 2)))
If tmpMillionen = "eins" Then 'Sonderfall "hundertEIN tausen"
tmpMillionen = "einemillion"
Else
tmpMillionen = tmpMillionen + "millionen"
End If
'Hundertmillionen ermitteln
If curMillionen \> 99 Then
tmpMillionen = getEiner(CInt(Left(CStr(curMillionen), 1))) + \_
"hundert" + tmpMillionen
End If
'Zehntausender ermitteln
tmpTausender = getZehner(CInt(Right(CStr(curTausender), 2)))
If tmpTausender = "eins" Then 'Sonderfall "hundertEIN tausen"
tmpTausender = "eintausend"
Else
tmpTausender = tmpTausender + "tausend"
End If
'Hunderttausender ermitteln
If curTausender \> 99 Then
tmpTausender = getEiner(CInt(Left(CStr(curTausender), 1))) + \_
"hundert" + tmpTausender
End If
'Zehner ermitteln
tmpHunderter = tmpHunderter + \_
getZehner(CInt(Right(CStr(curHunderter), 2)))
'Hunderter ermitteln
If curHunderter \> 99 Then
tmpHunderter = getEiner(CInt(Left(CStr(curHunderter), 1))) + \_
"hundert" + tmpHunderter
End If
'Zusammensetzen
getZahl\_in\_Worten = tmpMillionen + tmpTausender + tmpHunderter
Case Is \> 1000
curTausender = CInt(Left(CStr(curZahl), Len(CStr(curZahl)) - 3))
curHunderter = CInt(Right(CStr(curZahl), 3))
'Zehntausender ermitteln
tmpTausender = getZehner(CInt(Right(CStr(curTausender), 2)))
If tmpTausender = "eins" Then 'Sonderfall "hundertEIN tausen"
tmpTausender = Left(tmpTausender, Len(tmpTausender) - 1) + "tausend"
Else
tmpTausender = tmpTausender + "tausend"
End If
'Hunderttausender ermitteln
If curTausender \> 99 Then
tmpTausender = getEiner(CInt(Left(CStr(curTausender), 1))) + \_
"hundert" + tmpTausender
End If
'Zehner ermitteln
tmpHunderter = tmpHunderter + \_
getZehner(CInt(Right(CStr(curHunderter), 2)))
'Hunderter ermitteln
If curHunderter \> 99 Then
tmpHunderter = getEiner(CInt(Left(CStr(curHunderter), 1))) + \_
"hundert" + tmpHunderter
End If
'Zusammensetzen
getZahl\_in\_Worten = tmpTausender + tmpHunderter
Case Is \> 0
'Zehner ermitteln
getZahl\_in\_Worten = getZehner(CInt(Right(CStr(curZahl), 2)))
'Hunderter ermitteln
If curZahl \> 99 Then
getZahl\_in\_Worten = getEiner(CInt(Left(CStr(curZahl), 1))) + \_
"hundert" + getZahl\_in\_Worten
End If
End Select
End Function
'
' Unterfunktion zum umwandeln der Einer einer Zahl in Worte
'
Function getEiner(curEiner) As String
Select Case curEiner
Case 1
getEiner = "ein"
Case 2
getEiner = "zwei"
Case 3
getEiner = "drei"
Case 4
getEiner = "vier"
Case 5
getEiner = "fünf"
Case 6
getEiner = "sechs"
Case 7
getEiner = "sieben"
Case 8
getEiner = "acht"
Case 9
getEiner = "neun"
End Select
End Function
'
' Unterfunktion zum umwandeln der Zehner einer Zahl in Worte
'
Function getZehner(curZehner) As String
Dim tmpEiner As String
Select Case curZehner
Case Is "" Then tmpEiner = tmpEiner + "und"
Select Case (CInt(Left(CStr(curZehner), 1)) \* 10)
Case 20
getZehner = tmpEiner + "zwanzig"
Case 30
getZehner = tmpEiner + "dreißig"
Case 40
getZehner = tmpEiner + "vierzig"
Case 50
getZehner = tmpEiner + "fünfzig"
Case 60
getZehner = tmpEiner + "sechzig"
Case 70
getZehner = tmpEiner + "siebzig"
Case 80
getZehner = tmpEiner + "achtzig"
Case 90
getZehner = tmpEiner + "neunzig"
End Select
End Select
End Function
![http://www.abload.de/image.php?img=unbenanntd1rk7.png][img=http://www.abload.de/thumb/unbenanntd1rk7.png][/url](http://www.abload.de/image.php?img=unbenanntd1rk7.png%5D%5Bimg=http://www.abload.de/thumb/unbenanntd1rk7.png%5D%5B/url){kind=link}
