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

Question

我正在寻找在特定列中搜索特定关键字并将其突出显示为黄色的Excel代码;并且能够为多个列做到这一点，每个列都有自己独特的关键字。

示例：关键字 “河” 关键字 “海洋”

搜索列C关键字 “海”

搜索塔B

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

  该代码将包含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