Wörter in einem Textfeld zählen

[spoooner]

Hallo zusammen,

ich möchte in einem Textfeld die Anzahl der Wörter zählen lassen.

Ich hab es schon über eine Eselsbrücke versucht, die Lösung funktioniert aber nur Bedingt

for i = 1 to len(txt_eingabe.txt)
space_zähler = space_zähler + 1
next i

und dann die Ausgabe:

Wörter = space_zähler + 1
lblausgabe.caption = wörter

Probleme:
Wenn ich einen Zeilenumbruch mache zählt er immer ein Wort weniger, oder wenn ich hinter einem Wört mehrere Leerzeichen hinhaue und danach ein Wort schreibe zählt er das Leerzeichen als Wort.

Ich hoffe ihr könnt mir helfen, dass muss bestimmt auch anders zu lösen sein.

 

[Alex F.]

versuch es doch mit

instr

als vergleichszeichen wäre space wenn man davon ausgeht das zwischen jedem wort nur 1 space zeichen liegt würde es funktionieren. (doppelte oder mehrfachspace würde ich vorher mit replace eleminieren)

bsp

stringTest = textfeld1.text
stringtest= Replace ( stringtest ," ", "".0.0)
anzWörter = instr (stringtest," " ,0 ,0 )

Gruß bb

PS : Weiss nicht ob die syntaxt stimmt da kein debuger zur hand

 

[NRFi]

instr macht doch aber was anderes oder? es zeigt dir an, WO das erste wort anfängt, dass du suchst.

also ganz quick 'n' dirty würd ich das so machen:

    Dim arrWords() As String
    Dim iCount As Integer
    
    arrWords = Split(Replace(Me.txtDeinText.Text, "  ", " "), " ")
    'das replace macht alle doppelten leerzeichen zu einem einfachen.
    iCount = UBound(arrWords) + 1
    MsgBox "Dein Text enthält " & iCount & " Wörter."

 

[Nico192]

Hi!
ganz gut
Aber kann man auch einstellen, dass ein Komma (" , ") als "Trennung" gezählt wird?

Greetz N!C0 thx

 

[D@nger]

Hallo, klar geht das:

Private Sub Command1_Click()
    Dim arrWords() As String
    Dim iCount As Integer
    
    arrWords = Split(Text1.Text, ",")
   
    iCount = UBound(arrWords) + 1
    MsgBox "Dein Text enthält " & iCount & " Wörter."
End Sub

 

[Shakie]

Mir war grad langweilig, da hab ich mal eine etwas komplexere Wortzähl-Funktion gebaut. Und zwar so ähnlich wie D@anger hab ich die Split-Funktion verwendet und dann die Anzahl der Einträge im Array mit Ubound(Array) gezählt.
Allerdings beschränkt sich die Zähl-Funktion nicht auf ein Trennzeichen sondern zählt alle Wörter, die durch Komma, Punkt, Ausrufezeichen, Leerzeichen oder Zeilenumbruch getrennt sind.
Und man kann beliebig viele Leerzeichen/Trennzeichen hintereinander machen.

Private Sub Text1_Change()
    Me.lblCount.Caption = WortCount(Me.Text1.Text)
End Sub

Private Function WortCount(ByVal Text As String) As Integer

    Dim strTemp() As String
    Dim strGesamt() As String
    Dim i As Integer
    '----------------------------------------------------------
    'Wörter, die nur durch Leerzeichen getrennt sind, erfassen:
    strTemp = MySplit(Text, " ")
    
    If ArrayIsInitialized(strTemp) Then
    
        'Wörter, die nur durch "," getrennt sind, erfassen:
        For i = LBound(strTemp) To UBound(strTemp)
            JoinArray strGesamt, MySplit(strTemp(i), ",")
        Next
        strTemp = strGesamt
        Erase strGesamt
        
        'Wörter, die nur durch "!" getrennt sind, erfassen:
        For i = LBound(strTemp) To UBound(strTemp)
            JoinArray strGesamt, MySplit(strTemp(i), "!")
        Next
        strTemp = strGesamt
        Erase strGesamt
        
        'Wörter, die nur durch "." getrennt sind, erfassen:
        For i = LBound(strTemp) To UBound(strTemp)
            JoinArray strGesamt, MySplit(strTemp(i), ".")
        Next
        strTemp = strGesamt
        Erase strGesamt
        
        'Wörter, die nur durch Zeilenumbruch getrennt sind, erfassen:
        For i = LBound(strTemp) To UBound(strTemp)
            JoinArray strGesamt, MySplit(strTemp(i), vbCrLf)
        Next
        '----------------------------------------------------------
        'Anzahl aller Wörter entspricht der Anzahl der Einträge im Array "WortCount":
        WortCount = UBound(strGesamt) - LBound(strGesamt) + 1
    Else
        WortCount = 0
    End If
End Function

Private Function ArrayIsInitialized(ByRef CheckArray() As String) As Boolean
'FUNCTION: Überprüft, ob ein Array initialisiert ist.
    On Error Resume Next
    Dim blnDummy As Boolean
    blnDummy = (LBound(CheckArray) = 0)
    ArrayIsInitialized = (Err.Number = 0)
    Err.Clear
End Function

Private Sub JoinArray(ByRef Array1() As String, ByRef Array2() As String)
'SUB: Fügt die Einträge von Array2 zu Array1 hinzu.
    If ArrayIsInitialized(Array1) Then
        If ArrayIsInitialized(Array2) Then
            Dim i As Integer
            Dim intStart As Integer
            intStart = UBound(Array1) + 1
            
            'Array1 um die Anzahl der Einträge von Array2 erweitern:
            ReDim Preserve Array1(LBound(Array1) To intStart _
                + UBound(Array2) - LBound(Array2))
            
            'Einträge aus Array2 in Array1 kopieren:
            For i = 0 To UBound(Array2) - LBound(Array2)
                Array1(intStart + i) = Array2(LBound(Array2) + i)
            Next
        End If
    Else
        Array1 = Array2
    End If
End Sub

Private Function MySplit(ByVal Text As String, ByVal Trennzeichen As String) As String()
'SUB: Erstellt mittels Split-Funktion ein Array und löscht daraus alle leeren Einträge.
    Dim strArray() As String
    Dim strResult() As String
    Dim blnIsInitialized As Boolean
    Dim i As Integer
    
    strArray = VBA.Split(Text, Trennzeichen)
     
    For i = LBound(strArray) To UBound(strArray)
        If Len(strArray(i)) > 0 Then
            '--------------------------
            'Result-Array erweitern:
            If Not blnIsInitialized Then
                ReDim strResult(0 To 0)
                blnIsInitialized = True
            Else
                ReDim Preserve strResult(0 To UBound(strResult) + 1)
            End If
            '--------------------------
            'Wort in neuen Array-Eintrag kopieren:
            strResult(UBound(strResult)) = strArray(i)
            '--------------------------
        End If
    Next
    MySplit = strResult
End Function

Durch den Aufruf von "WortCount" wir die Anzahl der Wörter in einem Text ermittelt.

 

[DrSoong]

Hab noch eine kürzere:

Function WortCount(ByVal vWords As String) As Long
 Dim vLines() As String
 vWords = Selection.Text
 vWords = Replace(vWords, ",", " ")
 vWords = Replace(vWords, ".", " ")
 vWords = Replace(vWords, "!", " ")
 vWords = Replace(vWords, "?", " ")
 vWords = Replace(vWords, Chr(13), " ")
 'wenn gewünscht, kann man auch noch folgende Trennzeichen hinzufügen:
 'vWords = Replace(vWords, "/", " ")
 'vWords = Replace(vWords, ";", " ")
 'vWords = Replace(vWords, "-", " ")
 'vWords = Replace(vWords, "(", " ")
 'vWords = Replace(vWords, ")", " ")
 Do
  vWords = Replace(vWords, "  ", " ")
 Loop Until InStr(vWords, "  ") = 0
 vWords = Trim(vWords)
 vLines = Split(vWords, " ")
 WortCount = CLng(UBound(vLines()) + 1)
End Function

Der Doc!

 

[Shakie]

*an den Kopf hau*

 

[DrSoong]

Danke dass du mich erinnerst hast, hab vergessen der Funktion einen Rückgabewert zu geben. Habs aber korrigiert.


Der Doc!