AW: Umwandeln von beträgen in ausgeschriebenen text
20.08.2003 21:53:57
Franz Pölt
Hallo Lorenz,
probiere mal das aus:
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")
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 "*undmill*" Then
inWorten = WorksheetFunction.Substitute(inWorten, "einundmill", "einemill")
inWorten = WorksheetFunction.Substitute(inWorten, "undmill", "mill")
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
Aufruf:
z.B. inWorten(111) - Ergebnis "einhundertelf"
inWorten(A1) - Umwandlung der Zahl in A1 (Wert vor dem Komma)
Servus aus dem Salzkammergut
Franz