VB 5/6-Tipp 0551: Eine Zahl in Worten ausgeben
von Tobias Augustin
Beschreibung
Manchmal ist es praktisch, wenn man eine Zahl nebenbei auch als Text ausgeben kann. Das Beispiel zeigt, wie man die mit ganzen Zahlen bis 999.999.999 erreichen kann.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Timersteuerelement "Timer1" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Textfeld "Text1" ' Steuerelement: Beschriftungsfeld "Label1" Option Explicit Private curHunderter As Integer Private curTausender As Integer Private curMillionen As Integer ' ' erzeugt Zahlenstring und schreibt ihn in Label1 ' Private Sub Command1_Click() If CDbl(Text1) < 2147483647 Then Label1.Caption = Text1.Text + vbCrLf + _ getZahl_in_Worten(CLng(Text1)) Label1.Refresh Else Beep Label1.Caption = Text1.Text + vbCrLf + _ "<Zahl ist zu groß>" Label1.Refresh End If Timer1.Enabled = True End Sub ' ' erlaubt nur die eingabe von Zahlen in Textfeld ' Private Sub Text1_Change() If Not IsNumeric(Text1.Text) Then Beep Text1.Text = "" End If End Sub ' ' erzeugt eine Zufallszahl, die in Text1 geschrieben wird ' Private Sub Timer1_Timer() Timer1.Enabled = False Text1.Text = Int((999999999 - 0 + 1) * Rnd + 0) End Sub ' ' Hauptfunktion zum umwandeln einer Zahl in Worte ' Public Function getZahl_in_Worten(curZahl As Long) As String Dim tmpTausender As String, tmpMillionen As String Dim tmpHunderter As String Select Case curZahl Case Is > 999999999 getZahl_in_Worten = "<Zahl ist zu groß>" Case Is > 1000000 curMillionen = CInt(Left(CStr(curZahl), Len(CStr(curZahl)) - 6)) tmpTausender = Left(CStr(curZahl), Len(CStr(curZahl)) - 3) curTausender = CInt(Right(tmpTausender, 3)) tmpTausender = "" curHunderter = CInt(Right(CStr(curZahl), 3)) 'Zehnmillionen ermitteln tmpMillionen = getZehner(CInt(Right(CStr(curMillionen), 2))) If tmpMillionen = "eins" Then 'Sonderfall "hundertEIN tausen" tmpMillionen = "einemillion" Else tmpMillionen = tmpMillionen + "millionen" End If 'Hundertmillionen ermitteln If curMillionen > 99 Then tmpMillionen = getEiner(CInt(Left(CStr(curMillionen), 1))) + _ "hundert" + tmpMillionen End If 'Zehntausender ermitteln tmpTausender = getZehner(CInt(Right(CStr(curTausender), 2))) If tmpTausender = "eins" Then 'Sonderfall "hundertEIN tausen" tmpTausender = "eintausend" Else tmpTausender = tmpTausender + "tausend" End If 'Hunderttausender ermitteln If curTausender > 99 Then tmpTausender = getEiner(CInt(Left(CStr(curTausender), 1))) + _ "hundert" + tmpTausender End If 'Zehner ermitteln tmpHunderter = tmpHunderter + _ getZehner(CInt(Right(CStr(curHunderter), 2))) 'Hunderter ermitteln If curHunderter > 99 Then tmpHunderter = getEiner(CInt(Left(CStr(curHunderter), 1))) + _ "hundert" + tmpHunderter End If 'Zusammensetzen getZahl_in_Worten = tmpMillionen + tmpTausender + tmpHunderter Case Is > 1000 curTausender = CInt(Left(CStr(curZahl), Len(CStr(curZahl)) - 3)) curHunderter = CInt(Right(CStr(curZahl), 3)) 'Zehntausender ermitteln tmpTausender = getZehner(CInt(Right(CStr(curTausender), 2))) If tmpTausender = "eins" Then 'Sonderfall "hundertEIN tausen" tmpTausender = Left(tmpTausender, Len(tmpTausender) - 1) + "tausend" Else tmpTausender = tmpTausender + "tausend" End If 'Hunderttausender ermitteln If curTausender > 99 Then tmpTausender = getEiner(CInt(Left(CStr(curTausender), 1))) + _ "hundert" + tmpTausender End If 'Zehner ermitteln tmpHunderter = tmpHunderter + _ getZehner(CInt(Right(CStr(curHunderter), 2))) 'Hunderter ermitteln If curHunderter > 99 Then tmpHunderter = getEiner(CInt(Left(CStr(curHunderter), 1))) + _ "hundert" + tmpHunderter End If 'Zusammensetzen getZahl_in_Worten = tmpTausender + tmpHunderter Case Is > 0 'Zehner ermitteln getZahl_in_Worten = getZehner(CInt(Right(CStr(curZahl), 2))) 'Hunderter ermitteln If curZahl > 99 Then getZahl_in_Worten = getEiner(CInt(Left(CStr(curZahl), 1))) + _ "hundert" + getZahl_in_Worten End If End Select End Function ' ' Unterfunktion zum umwandeln der Einer einer Zahl in Worte ' Private Function getEiner(curEiner) As String Select Case curEiner Case 1 getEiner = "ein" Case 2 getEiner = "zwei" Case 3 getEiner = "drei" Case 4 getEiner = "vier" Case 5 getEiner = "fünf" Case 6 getEiner = "sechs" Case 7 getEiner = "sieben" Case 8 getEiner = "acht" Case 9 getEiner = "neun" End Select End Function ' ' Unterfunktion zum umwandeln der Zehner einer Zahl in Worte ' Private Function getZehner(curZehner) As String Dim tmpEiner As String Select Case curZehner Case Is < 20 'bis "zwanzig" Sonderfälle! Select Case curZehner Case 1 getZehner = "eins" Case 2 getZehner = "zwei" Case 3 getZehner = "drei" Case 4 getZehner = "vier" Case 5 getZehner = "fünf" Case 6 getZehner = "sechs" Case 7 getZehner = "sieben" Case 8 getZehner = "acht" Case 9 getZehner = "neun" Case 10 getZehner = "zehn" Case 11 getZehner = "elf" Case 12 getZehner = "zwölf" Case 13 getZehner = "dreizehn" Case 14 getZehner = "vierzehn" Case 15 getZehner = "fünfzehn" Case 16 getZehner = "sechzehn" Case 17 getZehner = "siebzehn" Case 18 getZehner = "achtzehn" Case 19 getZehner = "neunzehn" End Select Case Else 'größer zwanzig nur zehner ermitteln und einer aus andrer function tmpEiner = getEiner(CInt(Right(CStr(curZehner), 1))) If tmpEiner <> "" Then tmpEiner = tmpEiner + "und" Select Case (CInt(Left(CStr(curZehner), 1)) * 10) Case 20 getZehner = tmpEiner + "zwanzig" Case 30 getZehner = tmpEiner + "dreißig" Case 40 getZehner = tmpEiner + "vierzig" Case 50 getZehner = tmpEiner + "fünfzig" Case 60 getZehner = tmpEiner + "sechzig" Case 70 getZehner = tmpEiner + "siebzig" Case 80 getZehner = tmpEiner + "achtzig" Case 90 getZehner = tmpEiner + "neunzig" End Select End Select End Function '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von y20frank am 11.10.2005 um 12:41
Gibt es auch bereits jemanden, der eine Idee hat, wie man die Zahl sinnvoll nach z.B. 32 Zeichen trennen kann, ohne dass soetwas wie
einhundertzweiundsie-
bzigtausendneunhundet
dabei herum kommt? Das wäre noch eine coole Erweiterung ;-)
Kommentar von y20frank am 01.10.2005 um 19:12
Das Script macht mir Schwierigkeiten bei den Zahlen
1.000 (gibt aus: einhundert)
und 1.000.000 (gibt aus: einhunderttausend)
Bei dem ersten Fall habe ich die Abfrage in der Hauptroutine mal wie folgt geändert:
Case Is >= 1000
curTausender = CInt(Left(CStr(curZahl), Len(CStr(curZahl)) - 3))
curHunderter = CInt(Right(CStr(curZahl), 3))
... usw. und es hat bei 1.000 dann auch funktioniert.
Suche noch nach der Millionen... ;-)
MfG
y20frank
Kommentar von am 13.08.2004 um 17:26
Um 1000 abzufangen fügt das gleichzeichen hinzu!
---------
curZahl => 1000 Then
---------
Kommentar von Amegon am 07.05.2004 um 11:40
' erlaubt nur die eingabe von Zahlen in Textfeld
Private Sub Text1_Change()
If Not IsNumeric(Text1.Text) Then
Beep
Text1.Text = ""
End If
End Sub
kann man auch anders schreiben, sodass der user sich nciht wieder aufregt, alles neu zu tippen, sobald er ein falsches zeichen eingeben hat:
wir speichert den benötigten zahlenwert in der variable (im allgemeinen deklarationsbereich)
private iWert as Integer
dann können wir das textfeld schööön bunt machen :D
Private Sub Text1_Change()
If Not IsNumeric(Text1.Text) Then
Text1.BackColor = System.Drawing.Color.Red
Else
Text1.BackColor = System.Drawing.SystemColors.Window
iWert = Int(Text1.Text)
End If
End Sub
Kommentar von ManuelB am 07.05.2004 um 10:15
Um den Sonderfall 1000000(Eine Million) sowie 1000 abzudeken, habe ich am anfang der Funktion getZahl_in_Worten noch folgende Zeilen eingefügt:
Bereits vorhanden__________________________________________
Dim tmpTausender As String, tmpMillionen As String
Dim tmpHunderter As String
____________________________________________________________
If curZahl = 1000 Then
getZahl_in_Worten = "Eintausend"
End If
If curZahl = 1000000 Then
getZahl_in_Worten = "Eine Million"
End If
If curZahl = 1000 Or curZahl = 1000000 Then Exit Function
Bereits vorhanden___________________________________________
Select Case curZahl
Case Is > 999999999
____________________________________________________________
Kommentar von quickbasT am 02.02.2003 um 14:34
Schön und gut, aber wenn man 1000000 (Eine Million) eingibt, dann spuckt er einhunderttausend aus.
bei neun millionen kommt dann neunmillionentausend
Stimmt nicht ganz alles, wenn's höhere Beträge sind, aber sonst; Alle Achtung!
Kommentar von Chaos|Krieger am 25.01.2003 um 23:32
hi.. das teil hat nen fehler.. gibt mal 1000 ein..