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

我正在尝试编写一个Excel文档的代码，使我能够完成以下任务：

• 在工作表中search列出的一组单词（由名称pipe理器定义）
• 仅将所列出的单词作为整个单词进行search，同时考虑到大小写敏感性，之前/之后的标点符号等。
• 在他们的单元格（而不是单元格本身）中列出的单词格式化为新的字体颜色（理想情况下，我希望它突出显示，但我不确定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 

这里是我用过的结果格式的testing数据：

让我知道这是否会有所帮助。