How to find repeating words and count its?

[avkokin]

Hello.
There is the document which has some repeating words. I need to find
these words and after every found repeating word insert number of
repeat (in brackets). How do it?
Thank you very much.

 

[Shasur]

Sub All_Words_In_Doc()

Dim sWord
For Each sWord In ActiveDocument.Words
' Get the Word and Store it
MsgBox sWord
Next

End Sub

And then have a sorted list of these and loop it through. Regular
expressions could give you some advantage for counting

Cheers

Hi

Word, unfortunately does not have an option to give the no.of instances of a
word. One possible way is to extract the words in the document

 

[Greg Maxey]

Something like this:

Sub FindAndLabelWithSequentialNumber()
'Finds a specified text string and replaces with a sequential number
Dim oColWords As Collection
Dim oWord As Range
Dim SingleWord As String
Dim findText As String
Dim i As Long
Dim lngSeqNumber
Dim myRange As Range
Set oColWords = New Collection
For Each oWord In ActiveDocument.Words
SingleWord = Trim(LCase(oWord))
If SingleWord < "a" Or SingleWord > "z" Then
SingleWord = "" 'Out of range?
End If
On Error Resume Next
If SingleWord <> "" Then
oColWords.Add LCase(SingleWord), LCase(SingleWord)
On Error GoTo 0
End If
Next oWord
For i = 1 To oColWords.Count
Set myRange = ActiveDocument.Range
lngSeqNumber = 0
findText = oColWords(i)
With myRange.Find
.Text = findText
.MatchWholeWord = True
While .Execute
If lngSeqNumber > 0 Then
myRange.Text = myRange.Text & " {" & Format(lngSeqNumber, "000") &
"}"
myRange.Collapse Direction:=wdCollapseEnd
End If
lngSeqNumber = lngSeqNumber + 1
Wend
End With
Next i
End Sub

 

[avkokin]

Shasur, thank you, but the fact of the matter is that I don't know how
to count number of words in the text of document. And these words
might be any words into the text - or rather all words into the
text.
In other words I want to get number of entries of every word in the
text of document (in brackets). For example so: "I (5) want (2) to
(10) believe (1).". This mean what into the text of document the word
"I" meeting of 5 time, the word "want" - 2 time etc. Sorry for my not
perfect English.
Thank's.

 

[StevenM]

To: Avkokin,

Sub WordFrequencyCounter()
Dim WordList() As String
Dim WordCount() As Long
Dim nWords As Long
Dim Index As Long
Dim actDoc As Document
Dim oRange As Range
Dim aWord As Object
Dim sWord As String
Dim i As Long

ReDim WordList(1)
ReDim WordCount(1)
WordList(1) = ""
WordCount(1) = 0
nWords = 0
Set actDoc = ActiveDocument
'
' Count every word in the ActiveDocument
'
For Each aWord In actDoc.Words
sWord = Trim(aWord.Text)
If IsOnlyPunctuation(sWord) Then sWord = ""
If Len(sWord) > 0 Then
Index = 1
While (Index > 0 And Index <= nWords)
If StrComp(WordList(Index), sWord, vbTextCompare) = 0 Then
WordCount(Index) = WordCount(Index) + 1
Index = 0
Else
Index = Index + 1
End If
Wend
If Index > 0 Then
If nWords = 0 Then
nWords = 1
Else
nWords = nWords + 1
Application.StatusBar = "Counting Tokens in Document: "
& nWords
ReDim Preserve WordList(nWords)
ReDim Preserve WordCount(nWords)
End If
WordList(nWords) = sWord
WordCount(nWords) = 1
End If
End If
Next aWord
'
' Add Frequency to every word in the ActiveDocument
'
For i = actDoc.Words.count To 1 Step -1
Set oRange = actDoc.Words(i)
sWord = Trim(oRange.Text)
If IsOnlyPunctuation(sWord) Then sWord = ""
If Len(sWord) > 0 Then
Index = 1
While (Index > 0 And Index <= nWords)
If StrComp(WordList(Index), sWord, vbTextCompare) = 0 Then
'
'Found it
oRange.InsertAfter " (" & WordCount(Index) & ") "
Index = 0
Else
Index = Index + 1
End If
Wend
End If
Next i
End Sub

'
' IsOnlyPunctuation
' Returns true only if every character in a word string is punctuation
'
Private Function IsOnlyPunctuation(ByVal sWord As String) As Boolean
Dim sPunctuation As String
Dim sChar As String
Dim nIndex As Long
sPunctuation = " .,?';:![]{}()-_" & Chr(9) & Chr(10) & Chr(11) & Chr(12)
& Chr(13) & Chr(14) & Chr(34) & Chr(145) & Chr(146) & Chr(147) & Chr(148) &
Chr(150) & Chr(151) & Chr(160)
nIndex = 1
While (nIndex <= Len(sWord))
sChar = Mid(sWord, nIndex, 1)
If InStr(1, sPunctuation, sChar, vbBinaryCompare) = 0 Then
IsOnlyPunctuation = False
Exit Function
End If
nIndex = nIndex + 1
Wend
IsOnlyPunctuation = True
End Function

Steven Craig Miller

 

[avkokin]

Thank you very much for your helping.
Sincerely, Anton Kokin