Поиск одного слова из абзаца

Question

У меня есть список слов. Я хочу отметить это слово в абзаце, если он совпадает. если слово соответствует, то хочу изменить цвет.

Я использую этот код и работаю нормально. Например, в моем списке одно слово «есть». я хочу отметить только одно слово, а не в любом другом слове. как я могу это сделать?

Sub HighlightStrings()
Application.ScreenUpdating = False
Dim rng As Range
Dim InputRang As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
Dim xFNum As Integer
Dim xArrFnd As Variant
Dim xStr As String
Dim arr

arr = Join(Application.Transpose(Range("A1:A100").Value), ";")
cFnd = arr

If Len(cFnd) < 1 Then Exit Sub
xArrFnd = Split(cFnd, ";")
    For Each rng In Selection
        With rng
            For xFNum = 0 To UBound(xArrFnd)
            xStr = xArrFnd(xFNum)
            y = Len(xStr)
            m = UBound(Split(rng.Value, xStr))
                If m > 0 Then
                xTmp = ""
                    For x = 0 To m - 1
                    xTmp = xTmp & Split(rng.Value, xStr)(x)
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                    .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
                    xTmp = xTmp & xStr
                    Next
                End If
            Next xFNum
        End With
    Next rng
Application.ScreenUpdating = True
End Sub

Answer 1

Ваш код должен гарантировать, что искомый текст является полным словом ... а не подмножеством другого слова. Регулярные выражения, вероятно, лучший способ достичь этого. Например:

Option Explicit

Public Sub HighlightStrings()

    Dim vArray()
    Dim vCell As Range
    Dim vElement As Variant
    Dim vRegEx As New RegExp
    Dim vMatches As Variant
    Dim vMatch As Variant

    vArray = Application.Transpose(ActiveSheet.Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value)

    For Each vCell In Selection
        For Each vElement In vArray
            vRegEx.IgnoreCase = True
            vRegEx.Pattern = "\b" & vElement & "\b"
            Set vMatches = vRegEx.Execute(vCell)
            For Each vMatch In vMatches
                vCell.Characters(vMatch.FirstIndex + 1, vMatch.Length).Font.Color = vbRed
            Next
        Next
    Next

End Sub

Результат теста: