PDA

Archiv verlassen und diese Seite im Standarddesign anzeigen : ausgeschriebene Zahlen in Excel?



Un4given
24.05.2005, 21:13
moin moin,

hat jemand ne Idee, wie ich in Excel XP/2003 mir meine Zahlen ausgeschrieben anzeigen lassen kann?
Also wie bei einem Scheck:
da steht auch der Betrag z.B. 3500,00 € und noch mal der Betrag "in Worten": "dreitausendfünfhundert".
D. H. bei einem Ergebnis möchte ich in der Nachbarzelle den Wert in Worten ausgeschrieben haben, kapito?


Thx

Gruß Un4given

j-losi
26.05.2005, 15:23
Hm, jetzt geht es aber in VBA rein.

Du kopiertst dies hier in VBA (unter Excel ALT+F11)

Function inWorten$(wert$)
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)
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$ = "null"
End If
If (NK$ <> "") And (NK$ <> "0") And (NK$ <> "00") Then
If Len(NK$) = 1 Then
NK$ = NK$ + "0"
End If
TextG$ = TextG$ + " und " + NK$ + "/100"
End If
' TextG$ = Chr$(Asc(Left$(TextG$, 1)) - 32) + Right$(TextG$, Len(TextG$) - 1)
inWorten$ = TextG$
End Function


Dann die Zahl in a1 schreiben, in b1 dann "=inworten(a1)" und zack,
funktioniert.

Un4given
03.06.2005, 08:30
Jou danke für das Listing,

Antwort kommt erst spät, bin aber grad aus dem Urlaub zurück.

Wenn ich das Listing in das VB einfüge und abspeichere, habe ich nachher bei der Formeleingabe die Meldung "#Name?",
Woran liegts?Excel Version: 2003

Gruß
Un4given

j-losi
03.06.2005, 08:44
Ok, habe es die noch mal in einer TXT datei gegeben. Must alles vorher aus dem VB Editor löschen. Liegt nicht an Office!!!

Un4given
03.06.2005, 09:17
Habs grad ausprobiert j-josi, was mache ich falsch?
Hab alles in den Editor reinkopiert, der Editor erkennt auch das Listing als "inWorten".
Wenn ich über Datei den Editor schliesse und zu Excel zurückkehre, müßte doch das Listing als "inWorten" übernommen worden sein.
Also in kann die Formel "inWorten" ausführen, oder?

Gruß
Un4given

PS: Meld mich heut nachmittag noch mal, muß jetzt mal was schaffen, hihihi.
Danke für deine Hilfe

j-losi
03.06.2005, 09:20
Also in A1 die Zahl z.B. 123
dann in B1 schreiben =inworten(A1)
jetzt sollte alles in Worten in B erscheinen.

Un4given
03.06.2005, 09:30
Jou, habs ausprobiert,
klappt net!
Muß das Geschriebene im VB seperat abgespeichert werden?
Die Fehlermeldung sagt ja aus, das er die Bez. der Formel nicht kennt.

Gruß
Un4given

j-losi
03.06.2005, 09:40
Klar musst du es speichern!!!! :rolleyes:
Anleitung:
Excel öffenen, dass kannst du ja schon... :D
VB öffnen, dass klappt ja auch wunderbar.. :D ich mach das mit ALT+F11
Dann F5 (Makro ausführen) > Makroname vergeben (z.B. inworten) > erstellen > Sub inWorten() und End Function löschen > TXT Datei ins Fenster kopieren > dann auf Datei > Datei Exportieren > Namen Vergeben (inworten) > speichern > VB schließen.

Un4given
04.06.2005, 10:34
Jou, supi
hat geklappt!!!


Thx!

j-losi
06.06.2005, 08:01
Gut, viel Spaß damit... ;)