Microsoft Excel

Excel und VBA: Beitrag aus Herbers Excel-Forumsarchiv

Zahl in Wort schreiben

Betrifft: Zahl in Wort schreiben
von: Rüdiger
Geschrieben am: 03.02.2006 11:28:50

Hallo, kann mir jemand helfen?
Ich habe in einer x beliebigen Zelle 54065,45 stehen.

Jetzt soll aber die Zahl in einer anderen Zellein Worten stehen! (i.W.: xvierunfünfzigtausendfünfundsechzig 45/100x)
Da ich aber zu faul bin das immer zu schreiben, gibt es da nicht eine Vereinfachung über VBA?

Kann mir da jemand helfen um dieses Problem zu beheben.

Schon mal meinen besten Dank,

Rüdiger
  


Betrifft: AW: Zahl in Wort schreiben
von: ray
Geschrieben am: 03.02.2006 11:36:04

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 



     Code eingefügt mit Syntaxhighlighter 3.0


In der Tabelle nutzt du das als ganz normale Formel. "=InWorten(A1)" bzw. "=InWorten2(A1)"



  


Betrifft: AW: Zahl in Wort schreiben
von: Rüdiger
Geschrieben am: 03.02.2006 12:18:12

Hall Hans,
erst einmal vielen Dank.
Noch etwas zur Zahl:

in Zelle C199 steht: 54065,45EUR

in Zelle A214 steht ="i.W. X"&TEXT(C199;"#.##0,00")&"EURX"

In Zelle A215 soll der Betrag dann in Worten stehen.

Habe, wie am Anfang beschieben befolgt. nur wenn ich auf Macro Ausführen gehe passiert nichts.
Warum?
Wie muß ich das Macro denn ansprechen, damit es funkioniert?
Kannst Du mir das, für einen Laien beschreiben oder auch erklären!

Gruß Rüdiger


  


Betrifft: AW: Zahl in Wort schreiben
von: u_
Geschrieben am: 03.02.2006 12:36:16

Hallo,
hat er doch geschrieben.
In deinem Fall einfach =inworten(c199) in deine Zelle schreiben
Gruß

Geist ist geil!


  


Betrifft: AW: Hallo u_
von: Rüdiger
Geschrieben am: 03.02.2006 12:50:25

Hallo u_
Also nochmal von vorne.

Ich habe eine Umbuchungsbestätigung mit vielen Beträgen.
Die Zusammenrechnung der jeweiligen Beträge ist in Zelle c199 mit dem Betrag: 54065,45EUR, da es ein Zahlfeld mit Komma und 2 Stellen hinter dem Komma und mit dem Anhang von "EUR" ist.

In der Zelle a214 steht die Formel: ="X"&TEXT(C199;"#.##0,00")&"EURX", damit dort der Betrag aus Zelle c199 umgeschieben wird und dann steht dort: X54065,45EUR

In der Zelle A215 soll dann dieser Betrag aus Zelle c199 in Worten stehen und zwar so: i.W.: xvierundfünfzigtausendfünfundsechzig 45/100x

Wie kann ich dahingehend das Macro verändern, damit es genau das macht und wie spreche ich dieses Macro an.
Denke bitte daran ich bin Laie!

Grüße von Rüdiger


  


Betrifft: AW: Danke u_ hat geklappt
von: Rüdiger
Geschrieben am: 03.02.2006 14:32:44

Hallo, hat geklappt, Denkfehler, schönes Wochenende wünscht
Rüdiger