Подсчет количества некоторых слов в документе

Источник: wordexpert

Антон Кокин

Если вам нужно определить количество вхождений в документ некоторого слова, то здесь может помочь следующий макрос (навеяно заметкой Грега Макси "Count Selected Word\Phrase ").
Вы выделяете некое слово и запускаете макрос, который после подсчета выдает сообщение о количестве найденных слов:

Код макроса:

Sub CountWords()
'макрос подсчета количества определенных слов в документе
'для подсчета количества вхождений конкретного слова, это слово должно быть выделено
Dim rng As Range
Dim sWord As String
Dim i As Long
Set rng = ActiveDocument.Range
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
   MsgBox "Слово не выделено", vbExclamation
Else
'удаляем знак абзаца справа от слова
   If Right(Selection.Text, 1) = Chr(13) Then
      Selection.MoveLeft wdCharacter, 1, wdExtend
   End If
   sWord = Trim(Selection.Text)  'Убираем прообелы вокруг слова и запоминаем
   Selection.Collapse wdCollapseStart
   With rng.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = sWord
      .Forward = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Wrap = wdFindStop
      Do While .Execute
         i = i + 1
      Loop
   End With
   Select Case i
      Case 2 To 4
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раза", _
            vbInformation, "Подсчет слов"
      Case 1
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
      Case Else
         MsgBox "Слово " & Chr(171) & sWord & Chr(187) & " встречается в документе " & i & " раз", _
            vbInformation, "Подсчет слов"
   End Select
   rng.Find.Text = ""
End If
Application.ScreenUpdating = True
End Sub