Ich möchte Zahlen als Text ausgeben und habe hierzu einen VBA-Code. Dieses funktioniert auch im Zahlenbereich bis tausend.... allerdings hat der Code ein Problem, mit den folgenden Zahlen... 1000., 2000, 3000 usw.
Hier wirft mir der Code immer einundtausend, zweiundtausend, dreiundtausen usw. aus, wobei 1001 wieder richtig mit eintausendeins ausgegeben wird.
Hier mal der VBA-Code:
Function inWorten(var As Variant) As String
Dim j As Byte
Dim strZahl As String
Dim sX1 As String '1 Zeichen
Dim sX3 As String '3 Zeichen
Dim sVal As String 'millionen,tausend,hundert
If Val(var) > 999999999 Then inWorten = "": Exit Function
var = Int(CDbl(var) / 1)
strZahl = String(9 - Len(CStr(var)), "0") & CStr(var)
For j = 0 To 2
sX3 = Mid(strZahl, j * 3 + 1, 3)
Select Case j
Case 0
sVal = "million"
If Val(Right(sX3, 1)) > 1 Then sVal = "millionen"
Case 1
sVal = "tausend"
Case 2
sVal = ""
Case 3
sVal = ""
End Select
If Val(sX3) > 0 Then
inWorten = inWorten & Z2W(Left(sX3, 1), "hundert")
inWorten = inWorten & Z2W(Right(sX3, 1), "und") 'und gelöscht
inWorten = inWorten & Z2W0(Mid(sX3, 2, 1))
If inWorten Like "*undzehn" Then
inWorten = WorksheetFunction.Substitute(inWorten, "einundzehn", "elf")
inWorten = WorksheetFunction.Substitute(inWorten, "zweiundzehn", "zwölf")
inWorten = WorksheetFunction.Substitute(inWorten, "undzehn", "zehn")
inWorten = WorksheetFunction.Substitute(inWorten, "szehn", "zehn")
inWorten = WorksheetFunction.Substitute(inWorten, "enzehn", "zehn")
End If
If inWorten Like "*undtausend*" Then
inWorten = WorksheetFunction.Substitute(inWorten, "undtausend", "tausend")
End If
If inWorten Like "*undmillion*" Then
inWorten = WorksheetFunction.Substitute(inWorten, "einundmillion", "einemillion")
inWorten = WorksheetFunction.Substitute(inWorten, "undmillion", "million")
End If
inWorten = WorksheetFunction.Substitute(inWorten, "undnull", "")
inWorten = inWorten & sVal
End If
Next
If Right(inWorten, 3) = "und" Then inWorten = Left(inWorten, Len(inWorten) - 3)
If Right(inWorten, 3) = "ein" Then inWorten = inWorten & "s"
End Function
Function Z2W(ziffer As Byte, Optional sOpt As String) As String
Select Case ziffer
Case 0: Z2W = ""
Case 1: Z2W = "ein"
Case 2: Z2W = "zwei"
Case 3: Z2W = "drei"
Case 4: Z2W = "vier"
Case 5: Z2W = "fünf"
Case 6: Z2W = "sechs"
Case 7: Z2W = "sieben"
Case 8: Z2W = "acht"
Case 9: Z2W = "neun"
End Select
If sOpt <> "" And Z2W <> "" Then Z2W = Z2W & sOpt
End Function
Function Z2W0(ziffer As Byte) As String
Select Case ziffer
Case 0: Z2W0 = ""
Case 1: Z2W0 = "zehn"
Case 2: Z2W0 = "zwanzig"
Case 3: Z2W0 = "dreissig"
Case 4: Z2W0 = "vierzig"
Case 5: Z2W0 = "fünfzig"
Case 6: Z2W0 = "sechzig"
Case 7: Z2W0 = "siebzig"
Case 8: Z2W0 = "achtzig"
Case 9: Z2W0 = "neunzig"
End Select
End Function
Hat jemand eine Idee, was ich noch probieren könnte? Eine Testdatei habe ich mal angefügt, wo in Zelle A1 der Betrag als Zahl eingegeben wird und dann als Text in A2 ausgegeben wird.
Gruß
Roy
P.S. Auch ab 1.000.000 besteht ein Problem, auch wieder mit dem "und".
Hier wirft mir der Code immer einundtausend, zweiundtausend, dreiundtausen usw. aus, wobei 1001 wieder richtig mit eintausendeins ausgegeben wird.
Hier mal der VBA-Code:
Function inWorten(var As Variant) As String
Dim j As Byte
Dim strZahl As String
Dim sX1 As String '1 Zeichen
Dim sX3 As String '3 Zeichen
Dim sVal As String 'millionen,tausend,hundert
If Val(var) > 999999999 Then inWorten = "": Exit Function
var = Int(CDbl(var) / 1)
strZahl = String(9 - Len(CStr(var)), "0") & CStr(var)
For j = 0 To 2
sX3 = Mid(strZahl, j * 3 + 1, 3)
Select Case j
Case 0
sVal = "million"
If Val(Right(sX3, 1)) > 1 Then sVal = "millionen"
Case 1
sVal = "tausend"
Case 2
sVal = ""
Case 3
sVal = ""
End Select
If Val(sX3) > 0 Then
inWorten = inWorten & Z2W(Left(sX3, 1), "hundert")
inWorten = inWorten & Z2W(Right(sX3, 1), "und") 'und gelöscht
inWorten = inWorten & Z2W0(Mid(sX3, 2, 1))
If inWorten Like "*undzehn" Then
inWorten = WorksheetFunction.Substitute(inWorten, "einundzehn", "elf")
inWorten = WorksheetFunction.Substitute(inWorten, "zweiundzehn", "zwölf")
inWorten = WorksheetFunction.Substitute(inWorten, "undzehn", "zehn")
inWorten = WorksheetFunction.Substitute(inWorten, "szehn", "zehn")
inWorten = WorksheetFunction.Substitute(inWorten, "enzehn", "zehn")
End If
If inWorten Like "*undtausend*" Then
inWorten = WorksheetFunction.Substitute(inWorten, "undtausend", "tausend")
End If
If inWorten Like "*undmillion*" Then
inWorten = WorksheetFunction.Substitute(inWorten, "einundmillion", "einemillion")
inWorten = WorksheetFunction.Substitute(inWorten, "undmillion", "million")
End If
inWorten = WorksheetFunction.Substitute(inWorten, "undnull", "")
inWorten = inWorten & sVal
End If
Next
If Right(inWorten, 3) = "und" Then inWorten = Left(inWorten, Len(inWorten) - 3)
If Right(inWorten, 3) = "ein" Then inWorten = inWorten & "s"
End Function
Function Z2W(ziffer As Byte, Optional sOpt As String) As String
Select Case ziffer
Case 0: Z2W = ""
Case 1: Z2W = "ein"
Case 2: Z2W = "zwei"
Case 3: Z2W = "drei"
Case 4: Z2W = "vier"
Case 5: Z2W = "fünf"
Case 6: Z2W = "sechs"
Case 7: Z2W = "sieben"
Case 8: Z2W = "acht"
Case 9: Z2W = "neun"
End Select
If sOpt <> "" And Z2W <> "" Then Z2W = Z2W & sOpt
End Function
Function Z2W0(ziffer As Byte) As String
Select Case ziffer
Case 0: Z2W0 = ""
Case 1: Z2W0 = "zehn"
Case 2: Z2W0 = "zwanzig"
Case 3: Z2W0 = "dreissig"
Case 4: Z2W0 = "vierzig"
Case 5: Z2W0 = "fünfzig"
Case 6: Z2W0 = "sechzig"
Case 7: Z2W0 = "siebzig"
Case 8: Z2W0 = "achtzig"
Case 9: Z2W0 = "neunzig"
End Select
End Function
Hat jemand eine Idee, was ich noch probieren könnte? Eine Testdatei habe ich mal angefügt, wo in Zelle A1 der Betrag als Zahl eingegeben wird und dann als Text in A2 ausgegeben wird.
Gruß
Roy
P.S. Auch ab 1.000.000 besteht ein Problem, auch wieder mit dem "und".