поиск в предложении макросом

[Hugo121]

Хотя вот вроде получилось "попаразитировать" - 100% кода Николая плюс от меня чуть

Sub ertert()
Dim bibl, b, poisk As Range, r As Range, s As String
Application.ScreenUpdating = False

bibl = Range([e2], Cells(Rows.Count, 5).End(xlUp)).Value
Set poisk = Range([a2], Cells(Rows.Count, 1).End(xlUp))
poisk.Font.ColorIndex = xlAutomatic

For Each r In poisk.Cells
x = Split(r.Text)
For Each xx In x
    For Each b In bibl
    If xx = b Then
         s = InStr(r, b)
        If s Then r.Characters(s, Len(b)).Font.Color = vbRed
    End If
    Next b
Next xx
Next r
Application.ScreenUpdating = True
End Sub

Ну или тогда процент Николая можно чуть уменьшить (теперь лишнее выкинуть):

Option Explicit

Sub ertert()
Dim bibl, b, poisk As Range, r As Range, s As String
Dim x, xx$
Application.ScreenUpdating = False

bibl = Range([e2], Cells(Rows.Count, 5).End(xlUp)).Value
Set poisk = Range([a2], Cells(Rows.Count, 1).End(xlUp))
poisk.Font.ColorIndex = xlAutomatic

For Each r In poisk.Cells
x = Split(r.Text)
For Each xx In x
    For Each b In bibl
    If xx = b Then r.Characters(InStr(r, b), Len(b)).Font.Color = vbRed
    Next b
Next xx
Next r
Application.ScreenUpdating = True
End Sub

[nilem]

Тоже начал было так делать. А если там еще точки, запятые, дефисы и пр.? И искомые слова в предложении повторяются?
Dim x, xx$ надо Variant, процент просьба увеличить

[Hugo121]

Ну я думал, раз сплитим текст, то элемент массива - тоже текст... Ну да ладно, вариант беспроигрышный вариант
Да, точки/дефисы считать как часть слова, т.е. "фф"="фф-" или нет?
Если равно, то может просто тупо заменить их все на пробелы?

[nilem]

Без рег. выражений, видимо, никак.
Вот вариант, на больших диапазонах будет тормозить - слишком уж "поячеешно":

Sub ertert()
Dim bibl As Range, b As Range, poisk As Range, r As Range
Dim i As Long, l As Long: Application.ScreenUpdating = False

Set bibl = Range([e2], Cells(Rows.Count, 5).End(xlUp))
Set poisk = Range([a2], Cells(Rows.Count, 1).End(xlUp))
poisk.Font.ColorIndex = xlAutomatic: bibl.Font.ColorIndex = xlAutomatic

With CreateObject("VBScript.RegExp")
    .Global = True: .IgnoreCase = True
    For Each b In bibl.Cells
        .Pattern = "(^|\s)" & b & "[^а-я]+": l = Len(b)
        For Each r In poisk.Cells
            If .Test(r) Then
                b.Font.Color = vbBlue
                With .Execute(r)
                    For i = 0 To .Count - 1
                        r.Characters(.Item(i).FirstIndex + 1, l + 1).Font.Color = vbRed
                    Next
                End With
            End If
        Next r
    Next b
End With: Application.ScreenUpdating = True
End Sub

[Bape}l{ka]

оо, спасибо, я тоже заменила все лишнее на пробелы, сча буду разбираться с этим кодом)))

[Bape}l{ka]

вариант от nilem тоже ищет только частичные совпадения