Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Zahl in Worte "übersetzen" zB für Quittungsvorlage
zurück: Fehlermeldungen explizit abfragen weiter: Sverweis - Suchkriterium steht in der 1. oder der 2. Spalte Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
ae
Mein Name ist Ente


Verfasst am:
21. Jul 2004, 13:25
Rufname: Andreas
Wohnort: Reppenstedt bei Lüneburg

Zahl in Worte "übersetzen" zB für Quittungsvorlage - Zahl in Worte "übersetzen" zB für Quittungsvorlage

Nach oben
       

Immer wieder wird nachgefragt,
"Wie kann ich eine Zahl in Worte ausdrücken?"

Dazu erstelle eine benutzerdefinierte Funktion und nutze diese dann in der Tabelle

Zahl in Worten
AB
12417,26zweitausendvierhundertsiebzehn und 26/100
Formeln der Tabelle
B1 : =inworten(A1)

Der code für die Userdefined Function:

Code:
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


lala - 09. Sep 2004, 07:28 hat folgendes geschrieben:
hallo, andreas,

es geht auch ein wenig kürzer. bei herber wurde schon vor zig jahren folgende benutzerdefinierte funktion "entwickelt":

Code:

Dim BisNeunzehn As Variant
Dim Zehner As Variant
Dim Tausender As Variant

In Anlehnung an eine Klassenprogrammierung von Hans W. Hofmann
Function ZWort(dZahl As Double, Optional bln As Boolean)
   Dim dRest As Double
   dRest = WorksheetFunction.Round((dZahl - Fix(dZahl)), 2) * 100
   dZahl = Fix(dZahl)
   BisNeunzehn = Array("", "ein", "zwei", "drei", "vier", _
      "fünf", "sechs", "sieben", "acht", "neun", "zehn", _
      "elf", "zwölf", "dreizehn", "vierzehn", "fünfzehn", _
      "sechzehn", "siebzehn", "achtzehn", "neunzehn")
   Zehner = Array("", "zehn", "zwanzig", "dreißig", _
      "vierzig", "fünfzig", "sechzig", "siebzig", _
      "achtzig", "neunzig")
   Tausender = Array("", "tausend", "millionen", "milliarden")
   If dRest = 0 Then
      ZWort = Text(dZahl)
   Else
      If bln Then
         ZWort = Text(dZahl) & " " & dRest & "/00"
      Else
         ZWort = Text(dZahl)
      End If
   End If
End Function

Private Function Wort(wert As Integer) As String
   Dim h As Integer
   h = wert Mod 100
   If h < 20 Then       Wort = BisNeunzehn(h)    Else       Wort = BisNeunzehn(h Mod 10) & IIf(h Mod 10 > 0, "und", "") & _
         Zehner(Int(h / 10))
   End If
   h = (wert Mod 1000 - h) / 100
   If h > 0 Then Wort = BisNeunzehn(h) & "hundert" & Wort
End Function

Private Function Text(wert As Double)
   Dim l As Integer, i As Integer, p As Integer
   If InStr(1, Str(wert), ",") = 0 And InStr(1, Str(wert), ".") = 0 Then
      For i = 1 To 1 + Int(Len(Str(wert)) / 3)
         p = Val("0" & Mid("000" + Str(wert), _
            Len("000" & Str(wert)) - i * 3 + 1, 3))
         If p > 0 Then Text = Wort(p) & Tausender(i - 1) & Text
      Next
   Else
      Text = "#Ganzzahl!"
   End If
   If Right(Text, 3) = "ein" Then Text = Text & "s"
End Function


nur als ergänzung deines beitrags ... Very Happy

gruß! & all times the best
robert

Beitrag editiert. fridgenep


Das ganze nun auch auf Englisch aus einer Recherche von <Peter>

Code:


'****************
' Main Function *
'****************
'Quelle: Klaus Salmen, Neuseeland
Function SpellNumber(ByVal MyNumber)
    Dim Euro, Cents, Temp
    Dim DecimalPlace, Count

    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' String representation of amount
    MyNumber = Trim(Str(MyNumber))

    ' Position of decimal place 0 if none
    DecimalPlace = InStr(MyNumber, ".")
    'Convert cents and set MyNumber to dollar amount
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
       Temp = GetHundreds(Right(MyNumber, 3))
       If Temp <> "" Then Euro = Temp & Place(Count) & Euro
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop

    Select Case Euro
        Case ""
            Euro = "No Euro"
        Case "One"
            Euro = "One Dollar"
        Case Else
            Euro = Euro & " Euro"
    End Select

    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
        Case Else
            Cents = " and " & Cents & " Cents"
    End Select

    SpellNumber = Euro & Cents
End Function

'*******************************************
' Converts a number from 100-999 into text *
'*******************************************
Function GetHundreds(ByVal MyNumber)
    Dim Result As String

    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)

    'Convert the hundreds place
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred and "
    End If

    'Convert the tens and ones place
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If

    GetHundreds = Result
End Function

'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Function GetTens(TensText)
    Dim Result As String

    Result = ""           'null out the temporary function value
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
      Else                                 ' If value between 20-99
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty "
            Case 3: Result = "Thirty "
            Case 4: Result = "Forty "
            Case 5: Result = "Fifty "
            Case 6: Result = "Sixty "
            Case 7: Result = "Seventy "
            Case 8: Result = "Eighty "
            Case 9: Result = "Ninety "
            Case Else
        End Select
         Result = Result & GetDigit _
            (Right(TensText, 1))  'Retrieve ones place
      End If
      GetTens = Result
   End Function

'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function



Den Code in ein Modul kopieren.

AB
11.234,00One Thousand Two Hundred and Thirty Four Euro and No Cents
2125,35One Hundred and Twenty Five Euro and Thirty Five Cents
316,50Sixteen Euro and Fifty Cents
Formeln der Tabelle
B1 : =Spellnumber(A1)
B2 : =Spellnumber(A2)
B3 : =Spellnumber(A3)


_________________
Gruß
Andreas E
------
Oh Mann, ich fühl mich heute wie =DATEDIF(DATUM(1961;6;12);HEUTE();"y") Jahre alt


Zuletzt bearbeitet von ae am 08. Mai 2006, 18:15, insgesamt einmal bearbeitet
fridgenep
Gast


Verfasst am:
21. Apr 2006, 21:03
Rufname:


AW: Zahl in Worte "übersetzen" zB für Quittungsvor - AW: Zahl in Worte "übersetzen" zB für Quittungsvor

Nach oben
       

Bitte hier in den Tipps und Tricks keine Fragen zu den Beiträgen.

Wenn ihr eine Frage zu diesem Tipp habt, dann bezieht euch bitte im Forum mit einem Link auf diesen Tipp.

So bleiben die Tipps und Tricks übersichtlich.

Beitrag für weitere Fragen gesperrt.
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Doppelte eintäge und dazu noch kleinere Zahl anzeigen 0 markusr_ 678 17. Mai 2006, 07:59
markusr_ Doppelte eintäge und dazu noch kleinere Zahl anzeigen
Keine neuen Beiträge Excel Formeln: Ungleich Zahl 4 Enf 4899 05. Mai 2006, 00:02
Günni Ungleich Zahl
Keine neuen Beiträge Excel Formeln: Funktion für den Betrag einer Zahl 4 Stefanowitsch 123088 20. Apr 2006, 11:53
RippleN Funktion für den Betrag einer Zahl
Keine neuen Beiträge Excel Formeln: Erste Zahl einer Spalte finden 5 Jens-man 790 09. Feb 2006, 14:55
c0bRa Erste Zahl einer Spalte finden
Keine neuen Beiträge Excel Formeln: Zahl rausfiltern, und mit einem Wert in anderen Zeilen kopie 1 Gast 881 14. Jan 2006, 01:58
fridgenep Zahl rausfiltern, und mit einem Wert in anderen Zeilen kopie
Keine neuen Beiträge Excel Formeln: Datumsformat umwandeln in Zahl 2 Bonny 1406 09. Nov 2005, 22:43
Bonny Datumsformat umwandeln in Zahl
Keine neuen Beiträge Excel Formeln: ZÄHLENWENN eine Zahl vor der ein Minus steht 3 Gast 1118 07. Okt 2005, 11:59
Gast ZÄHLENWENN eine Zahl vor der ein Minus steht
Keine neuen Beiträge Excel Formeln: Zahl umwandeln in Minuten und Sekunden 3 yves 7077 19. Sep 2005, 08:40
c0bRa Zahl umwandeln in Minuten und Sekunden
Keine neuen Beiträge Excel Formeln: Betrag einer Zahl 2 pompeji 3530 23. Jul 2005, 16:30
pompeji Betrag einer Zahl
Keine neuen Beiträge Excel Formeln: Zahl mit Zahl ersetzen und mit der Formel Multiplizieren??? 7 Iggy 913 14. Apr 2005, 21:53
ae Zahl mit Zahl ersetzen und mit der Formel Multiplizieren???
Keine neuen Beiträge Excel Formeln: Zahl durch Wort ersetzen. 1 Carrear 3153 23. Feb 2005, 15:46
ae Zahl durch Wort ersetzen.
Keine neuen Beiträge Excel Formeln: zahl unsichtbar 1 traum1954 816 09. Feb 2005, 23:39
Scelina zahl unsichtbar
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: PHP JavaScript