Sub xu_18()
    Application.ScreenUpdating = False
    'нижняя* ячейка столбца A
    a = Cells(Rows.Count, "a").End(xlUp).Row
    'установим цвет шрифта = Авто
    Range("a1:a" & a).Font.ColorIndex = xlAutomatic
    'пройдемся циклом по ячейкам столбца A
    For b = 1 To a
        m = Range("a" & b).Value        'значение очередной ячейки
        n = Replace(m, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        c = n & " "                     'добавляем пробел в конец текста
        d = Len(c)                      'кол-во символов с пробелом в ячейке*
        e = Replace(c, " ", "")         'удалим* пробелы
        f = Len(e)                      'кол-во символов без пробелов
        g = d - f                       'кол-во пробелов = кол-во слов
        q = Range("b" & b).Value        'значение ячейки столбца B
        r = Replace(q, Chr(160), " ")   'заменяем* неразрывные пробелы обычными
        o = " " & r & " "               'добавим пробелы
        'пройдемся циклом по словам очередной ячейки
        i = 1 'начало слова
        For h = 1 To g
            l = Mid(c, i, d)        'текст без предыдущего слова
            j = InStr(l, " ")       'ищем очередной пробел
            k = " " & Mid(c, i, j)  'извлекаем* слово с пробелами
            p = InStr(o, k) 'ищем слово
            'если слово не найдено, выделяем
            If p = 0 Then
                Range("a" & b).Characters(Start:=i, Length:=j - 1).Font.Color = vbRed
            End If
            i = i + j 'начало очередного слова
        Next
    Next
    Application.ScreenUpdating = True
End Sub