在 Excel 的特定列中突出显示特定单词的代码

Question

我正在搜索一个在特定列中搜索特定关键字并将其突出显示为黄色的 excel 代码；并且能够为多个列执行此操作，每个列都有自己不同的关键字。

示例：

• 在 A 列中搜索关键字“河流”
• 在 B 列中搜索关键字“海洋”
• 在 C 列中搜索关键字“sea”

每次，唯一关键字仅在特定列中突出显示，即使它也可能出现在其他列中。

该代码将包含 100 列，从“A 列”到“CV 列”，并允许为每一列插入唯一的关键字。

这可能吗？

在论坛中搜索时，我发现了在 excel 中突出显示特定单词的代码，但没有将搜索范围缩小到一列并从其他列中排除关键字。

这段代码，找到一个单词并把它涂成红色，有一个类似的核心思想：

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 = "river"

' 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, cl, searchText, vbTextCompare)
  Loop

Next cl

End Sub

只有我需要黄色高光，而不是红色。我需要它用于 excel 2016，此代码适用于 excel 2010。

谢谢。

Answer 1

编辑：您可以突出显示单元格或更改单元格中特定文本的字体颜色。 Excel 没有突出显示单元格中特定文本背景的选项。

由于您只想看到搜索到的字符串被着色，因此我使用了 Font.ColorIndex 属性和红色而不是黄色，以便于查看。

我还声明了一个数组，以便您可以随意输入预定义的 100 个唯一关键字。

让我知道它是否适合你：

Sub Search_by_Column()
Dim rng As Range
Dim i As Long
Dim oldrngrow As Long
Dim myValue As String
Dim arr() As Variant

arr = Array("river", "ocean", "sea") '..... keep going till 100 keywords

For i = 1 To UBound(arr) + 1
   myValue = arr(i - 1)
   If myValue = vbNullString Then
      End
   End If
   Set rng = Cells.Find(What:=myValue, After:=Cells(1, i), LookIn:=xlFormulas, LookAt _
      :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
      False, SearchFormat:=False)
   If rng Is Nothing Then
      GoTo Skip
   End If

   oldrngrow = rng.Row
   Do While rng.Column = i
      rng.Characters(InStr(rng, myValue), Len(myValue)).Font.ColorIndex = 3
      Set rng = Cells.FindNext(After:=rng)
      If oldrngrow = rng.Row Then
        Exit Do
      End If
   Loop
Skip:
Next i
End Sub