vba 如何在 Excel 2010 中为给定范围或选择突出显示同一单元格中单词的每个实例？

How to highlight every instance of a word in the same cell for a given range or selection in Excel 2010?

提问by Steve

I would like to highlight in red and bold every instance of a word/phrase in the selected column of my Excel sheet (using Excel 2010). For example, if columns A1:A10 contain the sentence, "The brown fox likes the other brown fox," I would like to highlight every instance of "brown fox" in this range.

我想在我的 Excel 工作表（使用 Excel 2010）的选定列中以红色和粗体突出显示单词/短语的每个实例。例如，如果 A1:A10 列包含句子“The brown fox likes the other brown fox”，我想突出显示此范围内“brown fox”的每个实例。

I found a macro herewhich highlights only the first instance of "brown fox" in every cell:

我在这里找到了一个宏，它仅突出显示每个单元格中“棕狐”的第一个实例：

Sub colorText()

Dim cl As Range
Dim startPos As Integer
Dim totalLen As Integer
Dim searchText As String

' specify text to searh.
searchText = "brown fox"

' loop trough all cells in selection/range
For Each cl In Selection

  totalLen = Len(searchText)
  startPos = InStr(cl, searchText)

  If startPos > 0 Then
    With cl.Characters(startPos, totalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 3
    End With
  End If
Next cl

End Sub

I'd like to edit this macro so that it highlights every instance of "brown fox," not just the first. As an attempt, I tried the following:

我想编辑这个宏，使其突出显示“棕狐”的每个实例，而不仅仅是第一个。作为尝试，我尝试了以下操作：

Sub colorText()

Dim cl As Range
Dim startPos As Integer
Dim totalLen As Integer
Dim searchText As String
Dim endPos As Integer
Dim testPos As Integer

' specify text to search.
searchText = "brown fox"

' loop trough all cells in selection/range
For Each cl In Selection

  totalLen = Len(searchText)
  startPos = InStr(cl, searchText)
  testPos = 0

  Do While startPos > testPos
    With cl.Characters(startPos, totalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 3
    End With

    endPos = startPos + totalLen
    testPos = testPos + endPos
    startPos = InStr(testPos, searchText)
  Loop

Next cl

End Sub

However, this still only formats the first instance of "brown fox."

但是，这仍然只格式化“brown fox”的第一个实例。

Any thoughts/edits would be much appreciated.

任何想法/编辑将不胜感激。

回答by Octopus

Your error is on your logic. You should correct the code as below:

你的错误在于你的逻辑。您应该更正以下代码：

 startPos = InStr(testPos, cl, searchText, vbTextCompare)

Instead of doing this one:

而不是这样做：

 startPos = InStr(testPos, searchText)

In the second sub. Do you see now? :-)

在第二个子。你现在看到了吗？:-)

回答by Stu

I had the same problem when I was looking to format Specific words in a range of Cells. After several attempts and a lot of Internet searches, this is the one that worked the best...

当我想格式化一系列单元格中的特定单词时，我遇到了同样的问题。经过多次尝试和大量的互联网搜索，这是最有效的一个......

Sub FormatWords()
Dim Rng As Range, cl As Range, Red As Integer
Dim oStrg As String
Set Rng = Range(Range("D1"), Range("D" & Rows.Count).End(xlUp))
On Error Resume Next
oStrg = "Apple"
If oStrg = "" Then Exit Sub

For Each cl In Rng
    Red = InStr(1, cl, oStrg, vbTextCompare)

    Do Until Red = 0
        With cl.Characters(Red, Len(oStrg))
        .Font.Color = RGB(230, 25, 55)
        .Font.Bold = True
         End With
         Red = InStr(Red + 1, cl, oStrg, vbTextCompare)
    Loop
Next cl

oStrg = "Mango"
If oStrg = "" Then Exit Sub

For Each cl In Rng
    Orange = InStr(1, cl, oStrg, vbTextCompare)
    Do Until Orange = 0
        With cl.Characters(Orange, Len(oStrg))
        .Font.Color = RGB(250, 200, 0)
        .Font.Bold = True
        End With

        Orange = InStr(Orange + 1, cl, oStrg, vbTextCompare)
    Loop
Next cl

End Sub