从段落中查找单个单词

Question

我有一个单词列表。如果匹配，我想在段落中标记该单词。如果单词匹配然后想改变颜色。

我正在使用此代码并且工作正常。例如，在我的列表中，有一个单词“is”。我只想标记单个单词而不是任何其他单词。我该怎么做？

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

测试结果：