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

  • On-demand Event Event Date: September 10, 2014 Modern mobile applications connect systems-of-engagement (mobile apps) with systems-of-record (traditional IT) to deliver new and innovative business value. But the lifecycle for development of mobile apps is also new and different. Emerging trends in mobile development call for faster delivery of incremental features, coupled with feedback from the users of the app "in the wild." This loop of continuous delivery and continuous feedback is how the best mobile …

  • Is your IT Automation strategy saving you money or just becoming more complex and costly? With the right unified strategy, IT Automation can pay for itself and deliver far more business value. Watch this on-demand webinar, "New Strategies to Manage IT Automation Complexity" and learn how to: Reduce costs by integrating automation for servers, middleware, networks and databases Eliminate manual and tedious IT Operations tasks with both new and existing technology Save time and money by consolidating …

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds