Counting letters and words

[AChir]

I am trying to count letters and word lengths in a piece of text using code. I have two problems ans suspect that solving the first will solve the second. Here's the first:

I have a loop which (if formatcount=1) looks at each letter in turn and adds 1 to the counter for whatever that letter is. It always gets exactly double the correct answers.

I started dealing with this by just halving the answers but a similar probelm occurs when I count word lengths by counting characters between spaces. It overruns and appears to start back at the beginning of the text a second time, so the first half of the words are counted twice. Any ideas, please?

 

[Fizzio]

Post your code.

 

[AChir]

This is probably very clumsy, but...

TotalCharacters = Len(Text)
‘ for the letter count…
If FormatCount = 1 Then
For i = 1 To TotalCharacters
CurrentChar = Mid(Text, i, 1)
For j = 32 To 90
If CurrentChar = Chr(j) Then
LetterCount(j) = LetterCount(j) + 1
Else
End If
Next j
Next i
Else
End If

TotalSpaces = LetterCount(32) / 2

For the word length count…
PrevSpaceLocation = 0
If FormatCount = 1 Then
For i = 1 To TotalSpaces
SpaceLocation = InStr(PrevSpaceLocation + 1, Text, " ")
If (SpaceLocation - PrevSpaceLocation) < 26 Then
Wordlength(SpaceLocation - PrevSpaceLocation - 1) = _ Wordlength(SpaceLocation - PrevSpaceLocation - 1) + 1
Else
Wordlength(26) = Wordlength(26) + 1
End If
PrevSpaceLocation = SpaceLocation
Next i
Wordlength(TotalCharacters - InStrRev(Text, " ")) = Wordlength(TotalCharacters - InStrRev(Text, " ")) + 1
End If

Thank for looking
Sally

 

[IanW]

The word count is quite strauight forward (on the face of it anyway). Try:


Dim intCount As Integer
Dim varArray() As String

' Split words into array
varArray = Split(Trim("Test text test text "), " ")

intCount = UBound(varArray) + 1 ' Array is Zero Based

where intCount will be the no of words in the string. I'll give the letter count some thought. It could be a unicode issue, but I can't really see that to be honest.

 

[Fizzio]

Split is only avalable in A2k onwards mind you.

 

[IanW]

Good point. What version of access are you using

 

[AChir]

I'm using A2K but what I need it not the total word count but to know that there are 3 one letter words, 5 two letter words, 6 three letter words and so on

Your idea will help count the number of sentences, however, so thanks!

 

[AChir]

The word count works, thank you, but the sentence count (replacing " " with "." in the Split function) gives one too many some of the time.

 

[IanW]

It may give you a blank last value if the sentence has something after the last full-stop e.g. a Cariage Return.

As regards the word count , 3/4/5/6 letter words etc. I would us code like:

I would create a loop and increment intCount by 1 each time until you got to the UBound(intCount) value

select case len(varArray(intcount))

case 1
intOneLetterWords=intOneLetterWords+1

case 2
intTwoLetterWords=intTwoLetterWords+1

case 3
etc...

If this doesn't make sense please let me know,

Rgds,

Ian

 

[AChir]

Sorry - I'm confused here. I have tried setting up a loop as you suggested but I'm getting subscript out of range errors. If you have time, I'd be grateful for a little more help! Thanks very much

Sally

 

[Fizzio]

Try this demo I've just created. (Should work in A97 too I think). It may have flaws so any improvements greatly accepted!

 

[IanW]

Does your code look anything like this:

Dim strArray() As String
Dim intCount As Integer

strArray = Split("Iaskdjh ASDH Jh asdpjAPD PIASJIDJ ASIODJ", " ")

' This is the important bit
For intCount = LBound(strArray) To UBound(strArray)

' Code should be in this bit to process each word
Debug.Print strArray(intCount)

Next

Does this help?

Ian

 

[AChir]

Thank you both... I shall take it home and come back to you about it, if that's OK. I really appreciate your time and patience. Your demo is getting the sums right, Fizzio, but I'll look at both ideas as it seems to have problems with large chunks of text.

Thanks for the clarification of the loop, Ian. I'll have a go at that too!

 

[Fizzio]

It may have something to do with the variable dimming. I may have to dim them as long rather than integer. Also I have not screened for punctuation etc so this will give an inaccurate word length if the word is followed by punctuation. Doctor it as much as you want as I have only tried it with short examples.

 

[IanW]

test prog

Here is a bit of test code:

you can use Replace to remove any unwanted punctuation b4 passing it to the split function.


Sub test()

Dim strArray() As String
Dim intCount As Integer
Dim intNoOfWords(15) As Integer

strArray = Split("Iaskdjh ASDH Jh asdpjAPD PIASJIDJ ASIODJ", " ")

For intCount = LBound(strArray) To UBound(strArray)

Select Case Len(strArray(intCount))

Case 1
intNoOfWords(1) = intNoOfWords(1) + 1
Case 2
intNoOfWords(2) = intNoOfWords(2) + 1
Case 3
intNoOfWords(3) = intNoOfWords(3) + 1
Case 4
intNoOfWords(4) = intNoOfWords(4) + 1
Case 5
intNoOfWords(5) = intNoOfWords(5) + 1
Case 6
intNoOfWords(6) = intNoOfWords(6) + 1
Case 7
intNoOfWords(7) = intNoOfWords(7) + 1
Case 8
intNoOfWords(8) = intNoOfWords(8) + 1
Case 9
intNoOfWords(9) = intNoOfWords(9) + 1
Case 10
intNoOfWords(10) = intNoOfWords(10) + 1
Case 11
intNoOfWords(11) = intNoOfWords(11) + 1
Case 12
intNoOfWords(12) = intNoOfWords(12) + 1
Case 13
intNoOfWords(13) = intNoOfWords(13) + 1
Case 14
intNoOfWords(14) = intNoOfWords(14) + 1
Case 15
intNoOfWords(15) = intNoOfWords(15) + 1

' etc...

End Select

Next

For intCount = LBound(intNoOfWords) + 1 To UBound(intNoOfWords)

MsgBox "No of " & CStr(intCount) & " letter words is: " & CStr(intNoOfWords(intCount))

Next


End Sub

 

[Fizzio]

I have managed to sort out a few problems and bugs. I had to search the net for a workable string sort code (for the word list generator) so I suppose it it a bit of a cheat. Have a go and let me know of any improvements or anything I could add. Always like a challenge

 

[raskew]

Try copying this code to a new module, then calling it from the debug window with:

? countem(" THE QUICK BROWN FOX JUMPED OVER THE LAZY DOG now Is ThE time;")

Function Countem(myString As String) As Integer

Dim CurrentChar As String
Dim LetterCount(32 To 90) As Integer
Dim TotalCharacters As Integer
Dim i As Integer, j As Integer
Dim NumCount As Integer
Dim WordCount As Integer

'Total length of string, including leading spaces
TotalCharacters = Len(myString)
Debug.Print "Total characters = " & TotalCharacters

'Number of words in string.
WordCount = StrCount(onespace(myString), " ") + 1
Debug.Print "Total words = " & WordCount

'for the letter count…
For i = 1 To TotalCharacters
   CurrentChar = Mid(myString, i, 1)
   j = Asc(CurrentChar)
   If j >= 32 And j <= 90 Then
      LetterCount(j) = LetterCount(j) + 1
   End If
Next i

'number of valid (between 32 AND 90) characters
Debug.Print "Character Distribution:"
NumCount = 0
For j = 32 To 90
   NumCount = NumCount + LetterCount(j)
   If LetterCount(j) > 0 Then
      Debug.Print "Asc(" & j & ")= " & Chr(j) & ": " & LetterCount(j); ""
   End If
Next j
Debug.Print "Valid Characters: "
Countem = NumCount
End Function
'***************************************************************************
Function StrCount(ByRef TheStr As String, theItem As Variant) As Integer
'------------------------------------------------------------------
' PURPOSE: Counts the numbers of times an item occurs
'          in a string.
' ARGUMENTS: TheStr: The string to be searched.
'                          TheItem: The item to search for.
' RETURNS: The number of occurences as an integer.
'
' NOTES: To test:  Type '? StrCount("The quick brown fox jumped over
'                  the lazy dog", "the") in the debug window.
'                  The function will return 2.
'------------------------------------------------------------------
Dim strHold As String, itemhold As Variant
Dim placehold As Integer
Dim i As Integer, j As Integer

strHold = TheStr
itemhold = theItem
j = 0

If InStr(1, strHold, itemhold) > 0 Then
   While InStr(1, strHold, itemhold) > 0
      placehold = InStr(1, strHold, itemhold)
      j = j + 1
      strHold = Mid(strHold, placehold + Len(itemhold))
   Wend
   'Debug.Print "StrCount= " & j
End If
StrCount = j
End Function
'------------------------------------------------------------------

Function onespace(pstr As String)
'*******************************************
'Name:      onespace (Function)
'Purpose:   Removes excessive spaces from a string
'Inputs:    call onespace(" the    quick    brown fox")
'Output:    "the quick brown fox"
'*******************************************

Dim strHold As String
strHold = RTrim(pstr)
Do While InStr(strHold, "  ") > 0
  strHold = Left(strHold, InStr(strHold, "  ") - 1) & Mid(strHold, InStr(strHold, "  ") + 1)
Loop
onespace = Trim(strHold)
End Function
'------------------------------------------------------------------