在电子表格中搜索字符串并突出显示

Question

我在Excel中使用VBA来使用Sheet 2的字符串值列表和查询Sheet 1的数据来查看Sheet 2的值是否存在。如果存在，请突出显示Sheet1中的单元格。

我在表2中列出的清单如下：

COLUMN A

管理服务

高管

防火墙

发生器

互联网

IT应用支持

代理

补救

我的VBA是：

Private Sub CommandButton1_Click()

row_num = 1

Query = Sheet2.Range("A:A")

While Trim(ActiveCell.Value) <> ""

row_num = row_num + 1
    item_sum = Sheet1.Range("B" & row_num)
    item_note = Sheet1.Range("C" & row_num)
    item_group = Sheet1.Range("E" & row_num)

        If (InStr(item_sum, Query) Or InStr(item_note, Query) Or InStr(item_group, Query)) Then

            ActiveCell.Interior.Color = RGB(255, 255, 0)

        End If

Wend


End Sub

现在我没有错误标志，没有任何亮点。我尝试使用Sheet 2的A列的查询值，但我不确定它是否正常工作。

更新

我尝试将While循环更改为：

Do
DoEvents
row_num = row_num + 1
    item_sum = Sheet1.Range("B" & row_num)
    item_note = Sheet1.Range("C" & row_num)
    item_group = Sheet1.Range("E" & row_num)

        If (InStr(item_sum, Query) Or InStr(item_note, Query) Or InStr(item_group, Query)) Then

            ActiveCell.Interior.Color = RGB(255, 255, 0)

        End If

Loop Until item_sum = ""

但我突出显示了以下内容：

Answer 1

我认为您的代码运行得很好。唯一的问题是您没有突出显示正在检查的单元格，而是ActiveCell。因此，您可能需要考虑将其更改为以下内容：

Option Base 0
Option Explicit
Option Compare Text

Public Sub CommandButton1_Click()
Dim item_sum, item_note, item_group As String
Dim lngRowNumber As Long
Dim varFound As Variant
Dim rngQuery As Range

Set rngQuery = Sheet2.Range("A:A")
lngRowNumber = 1

Do
    If Trim(item_sum) = vbNullString Then Exit Do
    ' Go to the next row
    lngRowNumber = lngRowNumber + 1
    ' Get the data to look for
    item_sum = Sheet1.Range("B" & lngRowNumber).Value2
    item_note = Sheet1.Range("C" & lngRowNumber).Value2
    item_group = Sheet1.Range("E" & lngRowNumber).Value2
    ' Check the item_sum
    Set varFound = rngQuery.Find(item_sum, LookIn:=xlValues, LookAt:=xlPart)
    If Not varFound Is Nothing Then
        Sheet1.Range("B" & lngRowNumber).Interior.Color = RGB(255, 255, 0)
        Set varFound = Nothing
    End If
    ' Check the item_note
    Set varFound = rngQuery.Find(item_note, LookIn:=xlValues, LookAt:=xlPart)
    If Not varFound Is Nothing Then
        Sheet1.Range("C" & lngRowNumber).Interior.Color = RGB(255, 255, 0)
        Set varFound = Nothing
    End If
    ' Check the item_group
    Set varFound = rngQuery.Find(item_group, LookIn:=xlValues, LookAt:=xlPart)
    If Not varFound Is Nothing Then
        Sheet1.Range("E" & lngRowNumber).Interior.Color = RGB(255, 255, 0)
        Set varFound = Nothing
    End If
Loop

End Sub

显然，我还对整体代码做了一些小改动。希望其中一些是有帮助的。