Sub Stat()
'  òåêñòå âûäåëèòü öâåòîì è ïîäñ÷èòàòü ñëîâà ñîäåð. íå ìåíåå äâóõ ïîâòîð. áóêâ
Dim oWord As Object, s, i, j
On Error GoTo err_col
For Each oWord In ActiveDocument.Range.Words
    With New Collection
        s = Trim(Replace(oWord.Text, Chr(160), ""))
        For i = 1 To Len(s)
            .Add 0, Mid(s, i, 1)
        Next
next_word:
    End With
Next
With ActiveDocument
    .Range.InsertParagraphAfter
    If (j < 1) Then j = 0
  .Range.InsertAfter "Ñëîâ ñ ïîâ. áóêâàìè: " & j
    With .Paragraphs(.Paragraphs.Count).Range.Font
        .Size = 18
    End With
End With
Exit Sub

err_col:        ' ïðîïóñê ïðîáåëà
ActiveDocument.Range(oWord.Start, oWord.End + (Right(oWord.Text, 1) = " ")) _
    .HighlightColorIndex = wdYellow
j = j + 1
Resume next_word
End Sub
выделить цветов и подсч слов содерж не менее двух повтор букв