Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0551: Eine Zahl in Worten ausgeben

 von 

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:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [2,98 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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..