Allgemeines Modul als Tabellen Modul verwenden
09.01.2014 15:22:20
Golem
ich habe folgenden Code, um eine Zahl in ein Zahlwort zu ändern:
Option Explicit
'XL5/7/8-Makros von Hans W. Herber wie folgt Aufruf:
'=ZWORT(Zahl|Bezug]
Dim i%
Function ZWort(Zahl As Double) As String
Dim Teil1$, ATeil$, BTeil$, Rest$
If Fix(Zahl) = 0 Then
If Zahl = 0 Then
ZWort = "null"
Exit Function
Else
ZWort = Format((Zahl - Fix(Zahl)) * 100, "00") & "/100"
Exit Function
End If
End If
If Zahl = Fix(Zahl) Then
Rest = ""
Else
Rest = " " & Format((Zahl - Fix(Zahl)) * 100, "00") & "/100"
End If
If Zahl = 0 Then ZWort = "null": Exit Function
Zahl = Fix(Zahl)
If Zahl = 1 Then ZWort = "eins" & Rest: Exit Function
i = 0
ATeil = Right(Zahl, 3)
ZWort = Hunderter(ATeil)
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If ZWort > "" Then ZWort = ZWort & "tausend"
ZWort = ZWort & Teil1
If Right(ATeil, 3) = 1 Then ZWort = ZWort & "s"
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "million" & Teil1
Else
If ZWort > "" Then ZWort = ZWort & "millionen"
ZWort = ZWort & Teil1
End If
If Len(Str(Zahl)) Teil1 = ZWort
Zahl = Left(Zahl, Len(Str(Zahl)) - 4)
BTeil = Right(Zahl, 3)
ZWort = Hunderter(BTeil)
If BTeil = "1" Then
ZWort = "eine" & "milliarde" & Teil1
Else
ZWort = ZWort & "milliarden" & Teil1
End If
Beenden:
ZWort = ZWort & Rest
End Function
Private Function Hunderter(Hteil)
Dim eZahl%, Ziffer1$, Ziffer2$, Ziffer3$
eZahl = Right(Hteil, 1)
Hunderter = Einer(eZahl)
Ziffer3 = Hunderter
If Hteil "" Then
Hunderter = Hunderter & "und" & Zehner1(eZahl)
Else
Hunderter = Zehner1(eZahl)
Ziffer1 = Hunderter
End If
If Hteil 9 And Right(Hteil, 2) Private Function Einer(EinerZahl)
Select Case EinerZahl
Case Is = 1
Einer = "ein"
Case Is = 2
Einer = "zwei"
Case Is = 3
Einer = "drei"
Case Is = 4
Einer = "vier"
Case Is = 5
Einer = "fünf"
Case Is = 6
Einer = "sechs"
Case Is = 7
Einer = "sieben"
Case Is = 8
Einer = "acht"
Case Is = 9
Einer = "neun"
End Select
End Function
Private Function Zehner(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 10
Zehner = "zehn"
Case Is = 11
Zehner = "elf"
Case Is = 12
Zehner = "zwölf"
Case Is = 13
Zehner = "dreizehn"
Case Is = 14
Zehner = "vierzehn"
Case Is = 15
Zehner = "fünfzehn"
Case Is = 16
Zehner = "sechzehn"
Case Is = 17
Zehner = "siebzehn"
Case Is = 18
Zehner = "achtzehn"
Case Is = 19
Zehner = "neunzehn"
End Select
End Function
Private Function Zehner1(ZehnerZahl)
Select Case ZehnerZahl
Case Is = 2
Zehner1 = "zwanzig"
Case Is = 3
Zehner1 = "dreißig"
Case Is = 4
Zehner1 = "vierzig"
Case Is = 5
Zehner1 = "fünfzig"
Case Is = 6
Zehner1 = "sechzig"
Case Is = 7
Zehner1 = "siebzig"
Case Is = 8
Zehner1 = "achtzig"
Case Is = 9
Zehner1 = "neunzig"
End Select
End Function
Der v.g. Code kann bisher nur als allgemeines Modul verwendet werden.
Für evtl. Tipps oder Anregungen schon mal besten Dank!
Werner