Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
216to220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
216to220
216to220
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zahlwort

Zahlwort
12.02.2003 13:34:36
Gernot
Hallo liebe Excel-Freunde!
Gibt es eine Möglichkeit, daß ich in meiner Datenbank einen Betrag in der Nachbarspalte als "Zahlwort" umwandeln kann?
Z.B. Zelle A1 = 50,00 Euro
Nun soll in Spalte B1 "fünfzig" als "Zahlwort" erscheinen.
Kann man Stellen nach dem Komma einbeziehen?
Ist das möglich?
Ich würde mich über jede Antwort freuen. Vielen Dank vorab!

Grüße
Gernot


7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zahlwort
12.02.2003 13:42:51
ae

hallo gernot,
nachstehend ein code von Hans

nachfolgender Code (Posting von Hans)
Option Explicit
Function ZahlWort(dblZahl As Double, Optional bolArt As Variant)
Dim arrArt As Variant
Dim intCounter As Integer, intCts As Integer
Dim strWert As String, strTmp As String, strSuffix As String
On Error Resume Next
If bolArt = 1 Then
If Err = 0 Then
intCts = (dblZahl - Fix(dblZahl)) * 100
strSuffix = " " & Format(CStr(intCts), "00") & "/100"
Else
bolArt = 0
End If
End If
On Error GoTo 0
dblZahl = Fix(dblZahl)
strTmp = Right(CStr(dblZahl), 3)
strWert = Part(strTmp)
For intCounter = 1 To 4
strTmp = CStr(dblZahl)
Select Case Len(strTmp)
Case Is < 1 + 3 * intCounter
ZahlWort = strWert & strSuffix
Exit Function
Case Is < 4 + 3 * intCounter
strTmp = Left(strTmp, Len(strTmp) - intCounter * 3)
Case Else
strTmp = Left(Right(strTmp, 3 + intCounter * 3), 3)
End Select
Select Case intCounter
Case 1: arrArt = Array("tausend", "eintausend")
Case 2: arrArt = Array("millionen", "einemillion")
Case 3: arrArt = Array("milliarden", "einemillarde")
Case 4: arrArt = Array("billionen", "einebillion")
End Select
If Right(CStr(dblZahl), 3) = "000" Then
strWert = Part(strTmp) & arrArt(0)
ElseIf CInt(strTmp) = 1 Then
strWert = arrArt(1) & strWert
Else
strWert = Part(strTmp) & arrArt(0) & strWert
End If
Next intCounter
ZahlWort = strWert & strSuffix
End Function
Private Function Part(strPart As String) As String
Dim arrA As Variant, arrB As Variant, arrC As Variant
Dim strTmp As String
arrA = Array("null", "eins", "zwei", "drei", "vier", "fünf", "sechs", "sieben", "acht", "neun")
arrB = Array("elf", "zwölf", "dreizehn", "vierzehn", "fünfzehn", "sechzehn", "siebzehn", "achtzehn", "neunzehn")
arrC = Array("zehn", "zwanzig", "dreißig", "vierzig", "fünfzig", "sechzig", "siebzig", "achtzig", "neunzig")
If Len(strPart) = 1 Then
strTmp = arrA(CInt(Right(strPart, 1)))
ElseIf Right(strPart, 2) = "00" Then
If Left(strPart, 1) = "1" Then
Part = "einhundert"
Else
Part = arrA(CInt(Left(strPart, 1))) & "hundert"
End If
Exit Function
ElseIf Mid(strPart, Len(strPart) - 1, 1) = "0" Then
strTmp = arrA(CInt(Right(strPart, 1)))
ElseIf Mid(strPart, Len(strPart) - 1, 1) = "1" Then
If CInt(Right(strPart, 1)) <> 0 Then
strTmp = arrB(CInt(Right(strPart, 2)) - 11)
Else
strTmp = arrC(CInt(Mid(strPart, Len(strPart) - 1, 1)) - 1)
End If
ElseIf CInt(Mid(strPart, Len(strPart) - 1, 1)) > 1 Then
Select Case Right(strPart, 1)
Case "0"
strTmp = arrC(CInt(Mid(strPart, Len(strPart) - 1, 1)) - 1)
Case "1"
strTmp = "einund" & _
arrC(CInt(Mid(strPart, Len(strPart) - 1, 1)) - 1)
Case Else
strTmp = arrA(CInt(Right(strPart, 1))) & "und" & _
arrC(CInt(Mid(strPart, Len(strPart) - 1, 1)) - 1)
End Select
End If
If Len(strPart) = 3 Then
Select Case Left(strPart, 1)
Case "0"
Case "1"
strTmp = "einhundert" & strTmp
Case Else
strTmp = arrA(CInt(Left(strPart, 1))) & "hundert" & strTmp
End Select
End If
Part = strTmp
End Function


gruß
ae

Anzeige
Re: Zahlwort
12.02.2003 13:42:52
Steffen D

Hi Gernot,

im Archiv war ich fündig:

Public Function BetragInWorten(ByVal Betrag As Double) As String
Dim sBetrag As String
Dim I As Integer
Dim Gruppe As String
ReDim tmp1(3) As String
ReDim tmp2(3) As String
ReDim Grp(4) As String

If Betrag = 0 Then
BetragInWorten = "null"
Else
tmp1(1) = "einemilliarde": tmp2(1) = "milliarden"
tmp1(2) = "einemillion": tmp2(2) = "millionen"
tmp1(3) = "eintausend": tmp2(3) = "tausend"

sBetrag = LTrim$(Str$(Betrag))
sBetrag = String$(12 - Len(sBetrag), "0") + sBetrag
For I = 1 To 4
Gruppe = Mid$(sBetrag, (I - 1) * 3 + 1, 3)
If Gruppe <> "000" Then
If I <> 4 Then
If Gruppe = "001" Then
Grp(I) = tmp1(I)
Else
Grp(I) = GetGruppe(Gruppe) + tmp2(I)
End If
Else
Grp(I) = GetGruppe(Gruppe)
End If
End If
Next I
BetragInWorten = Grp(1) + Grp(2) + Grp(3) + Grp(4)
End If
End Function

'Die nachfolgende Funktion wird von der Hauptfunktion
'aufgerufen
Private Function GetGruppe(ByVal Gruppe As String) As String

'Dreiergruppen in Worten zusammenfassen

Dim Hunderter As String
Dim Zehner As String
Dim Einer As String

'Hunderterstellen
If Val(Mid$(Gruppe, 1, 1)) > 0 Then
If Mid$(Gruppe, 1, 1) = "1" Then
Hunderter = "einhundert"
Else
Hunderter = Choose(Val(Mid$(Gruppe, 1, 1)) + 1, "null", _
"eins", "zwei", "drei", "vier", "fünf", "sechs", _
"sieben", "acht", "neun") + "hundert"
End If
End If

'Zehnerstellen
If Val(Right$(Gruppe, 2)) >= 10 And _
Val(Right$(Gruppe, 2)) < 20 Then
Einer = Choose(Val(Right$(Gruppe, 2)) - 9, "zehn", "elf", _
"zwölf", "dreizehn", "vierzehn", "fünfzehn", "sechzehn", _
"siebzehn", "achtzehn", "neunzehn")
Else
If Val(Mid$(Gruppe, 2, 1)) > 1 Then
Zehner = Choose(Val(Mid$(Gruppe, 2, 1)) - 1, "zwanzig", _
"dreißig", "vierzig", "fünfzig", "sechzig", "siebzig", _
"achtzig", "neunzig")
End If
If Val(Mid$(Gruppe, 3, 1)) > 0 Then
'Einerstellen
If Zehner = "" Then
Einer = Choose(Val(Mid$(Gruppe, 3, 1)) + 1, "null", _
"eins", "zwei", "drei", "vier", "fünf", "sechs", _
"sieben", "acht", "neun")
Else
If Mid$(Gruppe, 3, 1) = "1" Then
Einer = "einund"
Else
Einer = Choose(Val(Mid$(Gruppe, 3, 1)) + 1, "null", _
"eins", "zwei", "drei", "vier", "fünf", "sechs", _
"sieben", "acht", "neun") + "und"
End If
End If
End If
End If

GetGruppe = Hunderter + Einer + Zehner
End Function


Gruß
Steffen D

Anzeige
eine sekunde zu spät..o.t. :-(
12.02.2003 13:44:04
Seffen D



Zahlwort als Formellösung
12.02.2003 14:01:20
WF

Hi Gernot,

siehe Tip Nr. 36 in der Rubrik Sonstige (8) auf meiner homepage
http://www.excelformeln.de/
die ultimative Formelseite

Salut WF

Wo ??
12.02.2003 14:10:05
ae

hallo wf,
war ganz gespannt - aber leider fängt die rubrik "sonstige " mit Tip 40 Fussballtip an !

Wo isses denn nu ??
gruß
ae

Kleine Anmerkung am rande : Eure Formelseite ist echt genial !!!

Re: Wo ?
12.02.2003 14:16:06
WF

Hi,

Du hast bei den Formeln geschaut; - Zahlwort ist bei den Tips.

Gruß WF

danke o T
12.02.2003 14:17:08
ae



Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige