通过仅匹配整个单词突出显示单元格中的单词（而不是单元格）？

Question

我正在尝试为excel文档创建代码，以便我完成以下任务：

• 在工作表中搜索列出的单词集（由名称管理员定义）
• 仅考虑整个单词列出的单词，同时考虑区分大小写，标点符号前面/后面的单词等。
• 将单元格中列出的单词（不是单元格本身）格式化为新的字体颜色（理想情况下我希望它突出显示，但我不确定Excel是否允许这样做。）

我目前有下面列出的代码，它突出显示单元格黄色并将列出的单词变为红色 - 但它匹配单词中的出现次数。我怎样才能使它只与整个单词匹配？

    Sub ColorCertainWords()
      Dim Z As Long, Position As Long, Words As Variant, Cell As Range
      Words = Range("LIST") 'LIST defined by name manager as list of words that cannot be used
      For Each Cell In Sheets("Sheet1").Range("A1:AA6000") 'Range of cells to be checked
        If Len(Cell.Value) Then
            For Z = 1 To UBound(Words)
              Position = InStr(1, Cell.Value, Words(Z, 1), vbTextCompare)
              Do While Position
                Cell.Characters(Position, Len(Words(Z, 1))).Font.ColorIndex = 3  'Red
                Cell.Interior.ColorIndex = 6 ' Yellow
                Position = InStr(Position + 1, Cell.Value, Words(Z, 1), vbTextCompare)
              Loop
            Next
        End If
      Next
      End Sub

Answer 1

这是您修改后的代码，可以帮助您继续前进。

Sub ColorCertainWords()
    Dim Z As Long, Position As Long, Words As Variant
    Dim Cell As Range, x As Integer, j As Integer
    Dim tempWords As Variant

    Words = Range("LIST")
    x = 1
    For Each Cell In Sheets("Sheet6").Range("A1:A6") 'Range of cells to be checked
        If Len(Cell.Value) Then
            tempWords = Split(Cell.Value, " ")  'Splitting cell value by space
            For i = LBound(tempWords) To UBound(tempWords)  'Looping through splitted values
                j = InStr(x, Cell.Value, " ") + 1
                For Z = 1 To UBound(Words)
                    If tempWords(i) = Words(Z, 1) Then  'Checking is words are matching
                        For k = 1 To Len(tempWords(i))
                            Cell.Characters(x, Len(tempWords(i))).Font.ColorIndex = 3  'Red
                            Cell.Interior.ColorIndex = 6 ' Yellow
                        Next
                    End If
                Next
                x = j
            Next
            x = 1
        End If
    Next
End Sub  

以下是我使用过的格式的测试数据：

请告诉我这是否有帮助。