查找并突出显示单元格范围内的特定单词

我想在一系列单元格中find一个特定的单词，然后用红色突出显示它。 要做到这一点，我创build了这个代码，但它只是在一行工作，并突出显示所有的单元格文本：

Sub Find_highlight() Dim ws As Worksheet Dim match As Range Dim findMe As String Set ws = ThisWorkbook.Sheets("MYSHEET") findMe = "Background" Set match = ws.Range("G3:G1362").Find(findMe) match.Font.Color = RGB(255, 0, 0) End Sub 

Answer 1

假设你的excel文件看起来像htis

要为特定的单词添加颜色，必须使用单元格的.Characters属性。 你需要find从哪里开始，然后给它着色。

尝试这个

 Option Explicit Sub Sample() Dim sPos As Long, sLen As Long Dim aCell As Range Dim ws As Worksheet Dim rng As Range Dim findMe As String Set ws = ThisWorkbook.Sheets("MYSHEET") Set rng = ws.Range("G3:G1362") findMe = "Background" With rng Set aCell = .Find(What:=findMe, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then sPos = InStr(1, aCell.Value, findMe) sLen = Len(findMe) aCell.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0) End If End With End Sub 

OUTPUT

Answer 2

添加了一个选项来循环

 Option Explicit Sub Macro1() Dim sPos As Long, sLen As Long Dim aCell As Range Dim ws As Worksheet Dim rng As Range Dim findMe As String Set ws = ThisWorkbook.Sheets("Sheet2") Set rng = ws.Range("A3:A322") findMe = "find" For Each rng In Selection With rng Set aCell = .Find(What:=findMe, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not aCell Is Nothing Then sPos = InStr(1, aCell.Value, findMe) sLen = Len(findMe) aCell.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(0, 255, 0) End If End With Next rng End Sub 

Answer 3

我做了一些更为一般和准确的改变

 Option Explicit Sub HIGHLIGHTER() Dim sPos As Long, sLen As Long Dim rng As Range Dim findMe As String Dim i As Integer Set rng = Application.InputBox(Prompt:= _ "Please Select a range", _ Title:="HIGHLIGHTER", Type:=8) findMe = Application.InputBox(Prompt:= _ "FIND WHAT?(YOU CAN USE PATTERN USED IN LIKE OPERATOR ", _ Title:="HIGHLIGHTER", Type:=2) For Each rng In rng With rng If rng.Value Like "*" & findMe & "*" Then If Not rng Is Nothing Then For i = 1 To Len(rng.Value) sPos = InStr(i, rng.Value, findMe) sLen = Len(findMe) If (sPos <> 0) Then rng.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0) i = sPos + Len(findMe) - 1 End If Next i End If End If End With Next rng End Sub 

Answer 4

我也做了一些更改，以便同时search多个单词。 我也拿走了提示和硬编码的search词。 剩下的唯一问题是使search不区分大小写。

 Sub HIGHLIGHTER() Dim sPos As Long, sLen As Long Dim rng As Range Dim findMe As String Dim i As Integer Dim t As Integer Dim SearchArray SearchArray = Array("WORD1", "WORD2") For t = 0 To UBound(SearchArray) Set rng = Range("N2:N10000") findMe = SearchArray(t) For Each rng In rng With rng If rng.Value Like "*" & findMe & "*" Then If Not rng Is Nothing Then For i = 1 To Len(rng.Value) sPos = InStr(i, rng.Value, findMe) sLen = Len(findMe) If (sPos <> 0) Then rng.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0) rng.Characters(Start:=sPos, Length:=sLen).Font.Bold = True i = sPos + Len(findMe) - 1 End If Next i End If End If End With Next rng Next t End Sub