String Function - CountWords

This short routine shows how to code a routine to return the number of words in a string (including strings containing CR/LF codes).
'
'Description :
'
'"Countwords" function can be used to determine number of
'words in a multiline string. The function breaks the source string
'into lines and passes each line to the function "countwordsinline"
'to get number of words in each line.
' 
' 
public Function countwordsinline(byval sourceline as string) _
       as Long
    Dim nextspaceindex as Long
    sourceline = sourceline & " "
'Every word has space at its end
    nextspaceindex = InStr(sourceline, " ")
    While nextspaceindex <> 0
        If nextspaceindex <> 1 then countwordsinline = _
           countwordsinline + 1
        sourceline = mid$(sourceline, nextspaceindex + 1)
        nextspaceindex = InStr(sourceline, " ")
    Wend
End Function
'
public Function countwords(byval source as string) as Long
    Dim endindex as Long
    source = source & Chr$(13)
    endindex = InStr(source, Chr$(13))
    While (endindex <> 0)
        countwords = countwords + countwordsinline(mid$(source, _
                                                   1, endindex - 1))
        source = mid$(source, endindex + 2)
'VB vbCrLf contains 2 Characters
        endindex = InStr(source, Chr$(13))
    Wend
End Function
'


Comments

  • This is much simpler...

    Posted by Legacy on 01/09/2004 12:00am

    Originally posted by: Dave W

    Regular expressions have a word boundary character. Just apply it to the string and divide the length of the resulting collection by 2 (since each word has a beginning and ending boundary)...
    
    

    Function wordcount(instring)
    Dim regex, matches
    Set regex = New RegExp
    regex.Pattern = "\b"
    regex.Global = True
    Set matches = regex.Execute(instring)
    wordcount = matches.count /2
    Set regex = nothing
    Set matches = nothing
    End Function

    Reply
  • Count words

    Posted by Legacy on 08/01/2003 12:00am

    Originally posted by: G.Subramani

    Option Explicit
    
    

    Function CountFields(LineDataIn As String, _
    Delimiter As String) As Integer
    Dim NewPos As Integer
    Dim MaxPos As Integer
    Dim FieldCounter As Integer

    If LineDataIn = "" Or Delimiter = "" Then
    CountFields = 0
    Exit Function
    End If

    MaxPos = Len(LineDataIn)
    NewPos = 1
    FieldCounter = 0

    While (NewPos < MaxPos) And (NewPos <> 0)
    NewPos = InStr(NewPos, LineDataIn, _
    Delimiter, vbTextCompare)
    If NewPos <> 0 Then
    FieldCounter = FieldCounter + 1
    NewPos = NewPos + 1
    End If
    Wend
    CountFields = FieldCounter
    End Function


    Sub CmdTest_Click()
    'This is just a test routine and isn't required....
    'Just here to show how the code can be used.

    Dim NumberOfFields As Integer
    Dim Delimiter As String
    Dim LineDataIn As String

    Delimiter = InputBox$("Type a Field Delimiter", "DEMO:Delimited Field Counter", ",")
    LineDataIn = InputBox$("Enter a Delimted String to have its fields counted", "DEMO:Delimited Field Counter")

    NumberOfFields = CountFields(LineDataIn, Delimiter)
    MsgBox "There are: " + Str$(NumberOfFields) + " fields in the string (" + LineDataIn + ")", 64, "DEMO:Delimited Field Counter"
    End Sub

    Reply
  • Count Words

    Posted by Legacy on 11/15/2001 12:00am

    Originally posted by: Chris Lucas

    I have a much faster word count routine, it also uses less lines of code.  Hey less to maintain and fewer CPU cycles, how can you lose?
    
    

    At the top of a module in the project place the following API function:

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

    Now the function itself:

    Public Function WordCount(Text As String) As Long
    Dim dest() As Byte
    Dim i As Long

    If LenB(Text) Then
    ReDim dest(LenB(Text))
    CopyMemory dest(0), ByVal StrPtr(Text), LenB(Text) -1
    For i = 0 To UBound(dest) Step 2
    If dest(i) > 32 Then
    Do Until dest(i) < 33
    i = i + 2
    Loop
    WordCount = WordCount + 1
    End If
    Next i
    Erase dest
    Else
    WordCount = 0
    End If
    End Function

    Thats it. Speed is highly dependant on the string itself, but on my box with a string of 50,000 words all seperated by one space, this function performed 87 times faster.
    One important note: WordCount deals with extra spaces, and all manner of carriage returns flawlessly. Please direct any comments or questions to cdl1051@earthlink.net.

    --Chris

    Reply
  • countwords

    Posted by Legacy on 10/06/2001 12:00am

    Originally posted by: zul

    could you give more example to me, beacuse I'm a new beginner  programmer
    

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • Live Event Date: October 29, 2014 @ 11:00 a.m. ET / 8:00 a.m. PT Are you interested in building a cognitive application using the power of IBM Watson? Need a platform that provides speed and ease for rapidly deploying this application? Join Chris Madison, Watson Solution Architect, as he walks through the process of building a Watson powered application on IBM Bluemix. Chris will talk about the new Watson Services just released on IBM bluemix, but more importantly he will do a step by step cognitive …

  • QA teams don't have time to test everything yet they can't afford to ship buggy code. Learn how Coverity can help organizations shrink their testing cycles and reduce regression risk by focusing their manual and automated testing based on the impact of change.

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds