Нахождение слов,содержащих 2 или более одинаковых букв

Option Explicit
Public i As Long
 
Sub moo_count()
i = 0
Dim km As Byte
Selection.HomeKey wdStory           ' поиск с начала документа
With Selection.Find
    .Text = "<*>"                   ' шаблон выделения любого слова
    .MatchWildcards = True          ' подстановочные знаки
    .Wrap = wdFindStop
    
        Do While .Execute           ' поиск срабатывает - очередное слово выделено
        .Text = "[MmМм]"
        km = 0
            Do
            If .Execute Then km = km + 1            ' считаем в выделенном слове букву м
            If km > 1 Then i = i + 1: Exit Do       ' считаем слово, где больше чем 1 м
            Selection.MoveRight                     ' перемещение к следующему символу
            Loop Until Not Selection Like "[A-zА-я]" 'курсор не на слове - идём дальше
        Selection.MoveRight wdWord  ' перемещение вправо к следующему слову
        .Text = "<*>"               ' шаблон выделения любого слова
        Loop
End With
MsgBox "Количество „мычащих слов”: " & i & "."
End Sub

Option Explicit
Public i As Long
 
Sub moo_count()
i = 0                               ' искомое количество (Public: общедоступно)
Dim km As Integer
Selection.HomeKey wdStory           ' поиск с начала документа
With Selection.Find
    .Text = "<*>"                   ' любое слово
    .MatchWildcards = True          ' подстановочные знаки
        Do While .Execute           ' поиск срабатывает - очередное слово выделено
        .Text = "?"                 ' любой символ (подстановочный знак при поиске)
        km = 0
            Do
            .Execute
            If Selection.Text Like "[MmМм]" Then km = km + 1 ' считаем в слове эм
            If km > 1 Then i = i + 1: Exit Do ' считаем слово, где больше чем 1 м
            Loop Until Not Selection Like "[-A-zА-я]" 'выход, когда курсор за словом
        Selection.MoveRight wdWord  ' перемещение вправо к следующему слову
        .Text = "<*>"               ' снова любое слово
        Loop
    .Text = ""                      ' очистка диалогового окна поиска
    .MatchWildcards = False         ' снятие флажка "подстановочные знаки"
End With
MsgBox "Количество „мычащих слов” равно " & i & "."
End Sub

Sub bb()
Dim w, i&
With GetObject("c:\temp\Толковый словарь.doc")
    For Each w In .words
        If Len(w) - Len(Replace(w, "м", "", , , vbTextCompare)) > 1 Then i = i + 1
    Next
    If .Application.documents.Count = 1 Then .Application.Quit Else .Close 0
End With
MsgBox "Мычащих слов: " & i
End Sub

Sub bb()
Dim w, i&
With GetObject("c:\temp\Толковый словарь.doc")  'получить объект Word.Document
                'если приложение Word запущено, документ откроется в нем, но будет невидимым.
                'если не запущено, то будет запущено и будет невидимым
    For Each w In .words    'w - объект типа (word)Range, у которого свойством по умолчанию
                'является Text (String), поэтому с ним можно обращаться как со строкой
        If Len(w) - Len(Replace(w, "м", "", , , vbTextCompare)) > 1 Then i = i + 1
                'Разность длины исходной строки и строки, в которой удалены буквы "м"
                'в обоих регистрах
    Next
    If .Application.documents.Count = 1 Then .Application.Quit Else .Close 0
                'если в приложении Word открыт один документ (этот), то закрыть приложение,
                'иначе закрыть только этот документ без сохранения.
End With
MsgBox "Мычащих слов: " & i
End Sub

Sub bb1()
Dim w, i&, p
With GetObject("c:\temp\Толковый словарь.doc")
    For Each p In .paragraphs
        For Each w In Split(p)
            If Len(w) - Len(Replace(w, "м", "", , , vbTextCompare)) > 1 Then i = i + 1
        Next
    Next
    If .Application.documents.Count = 1 Then .Application.Quit Else .Close 0
End With
MsgBox "Мычащих слов: " & i
End Sub