Sub findKeywords()
    Dim keywords, count As Integer, msg As String
    msg = ""
    keywords = Array("не более", "не менее", " или")
    For Each keyword In keywords
        Set myRange = ActiveDocument.Content
        count = 0
        With myRange.Find
            .Text = keyword
            Do While .Execute(Forward:=True) = True
                count = count + 1
                myRange.HighlightColorIndex = wdYellow
            Loop
            If count > 0 Then
                msg = msg & "'" & keyword & "' : " & count & " шт." & vbCrLf
            End If
        End With
    Next
    If msg <> "" Then
        MsgBox ("Найдены ключевые слова:" & vbCrLf & vbCrLf & msg)
    Else
        MsgBox ("Поиск не дал результатов")
    End If
End Sub