title image


Smiley Re: Wiederholung einer Zahl in Worten (VBA?)
Habe mir mal eine Funktion geschrieben. Funktioniert m.e. ganz gut: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 FunctionIch hoffe sie hift Dir weiterGrüßeHH=:-)

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: