用於突出顯示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