如果单元格值匹配，VBA将为单元格着色

我对VBA比较陌生，有一个脚本，它搜索数组“VC”，并通过将匹配单元格涂成红色来更改范围内的匹配单元格

我的问题是，我需要将条件从-MyArr=Array（“VC”）更改为搜索列A，并在“B2:D20”范围内的同一行中找到任何对应的匹配项，然后将匹配项涂成红色，如下脚本所示

根据下面的脚本，我不想要区分大小写的搜索，我正在使用XLpart包含部分匹配。请帮忙，谢谢

Sub Mark_cells_in_column()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim I As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    MyArr = Array("VC")
    With Sheets("Sheet1").Range("A2:d20")
        For I = LBound(MyArr) To UBound(MyArr)
             Set Rng = .Find(What:=MyArr(I), _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rng.Interior.ColorIndex = 3
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

子标记列（）中的单元格
将第一个地址设置为字符串
Dim MyArr作为变异体
变暗Rng As范围
我想我会坚持多久
应用
.ScreenUpdate=False
.EnableEvents=False
以
MyArr=数组（“VC”）
带图纸（“图纸1”）。范围（“A2:d20”）
对于I=LBound（MyArr）到UBound（MyArr）
Set Rng=.Find（What:=MyArr（I）_
之后：=.Cells（.Cells.Count）_
LookIn:=xl公式_
看：=xlPart_
搜索顺序：=xlByRows_
SearchDirection:=xlNext_
匹配案例：=假）
如果不是，那么Rng什么都不是
FirstAddress=Rng.Address
做
Rng.Interior.ColorIndex=3
设置Rng=.FindNext（Rng）
非Rng时循环为Nothing，Rng.Address为FirstAddress
如果结束
接下来我
以
应用
.ScreenUpdate=True
.EnableEvents=True
以
端接头

---

样本数据：

---

这将遍历A列中的所有单元格，将每个单元格值（以逗号分隔）拆分为单独的项目，并通过B到D列搜索同一行中的每个项目（不区分大小写）

---

---

结果

你可以试试这个

Public Sub Main()
    Dim cell As Range, cell2 As Range
    For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A2:A20")
        For Each cell2 In cell.Offset(, 1).Resize(, 3)
            If Instr(cell.Value, cell2.Value) > 0 Then cell2.Interior.ColorIndex = 3
        Next
    Next 
End Sub

或

---

是否有理由需要在VBA中而不是使用内置工具（如条件格式）执行此操作？是的，我的理由是VBA比条件格式更快。我的应用程序的前端已经有了很多数组公式，我想如果我添加了条件格式，它会使应用程序无法使用。当用户复制和粘贴条件格式设置范围内的单元格时，条件格式设置规则也会出现重复问题…在我知道之前，我将有数百条重复的条件格式设置规则：）恐怕您的操作完全是反向的。内置功能（如条件格式）是用比VBA高效得多的编码语言构建的，并由数十亿美元公司的专业团队进行了严格测试，因此，如果使用得当，其效率和可靠性将比自定义编写的VBA高出数倍。至于您对重复复制单元格的担忧：如果您单独格式化一个单元格，然后复制它，这将是一个合理的担忧。（这就形成了格式的“两个副本”）…@ashleedawg，我也经历了由于条件格式传播而导致工作表增长/失控的情况。所以我倾向于尽量少用它。@ashleedawg holy Words Hanks Paul，这并不完全是我想要的。让我试着用一个例子来更好地解释。我要做的是查看A1的值，如果范围B1:D1与A1的值相同，则高亮显示与A1匹配的单元格。该标准应循环通过每一行，直至第A20行。A1可能包含多个值，如“RT、VC、BB、TR”。我希望VBA检查每个单元格内的每个值，例如，如果B1值为“BB”，则符合标准，并且该单元格将以红色突出显示。我希望这有意义？另一个问题：假设你有

A1=“RT，VC，BB，TR”

。是否只在B1、C1和D1中查找每个值？或者列B、C和D中的所有行？嗨，保罗，我将尝试更新我的原始帖子，以提供上面所表达的更多细节。关于你的最后一个问题，我只想看看B1、C1和D1。必须根据A列中的对应值检查所有行。例如，A5仅用于确定B5、C5和D5，然后移到下一行。。。直到第20排。此外，A列中的每个值由“，”和空格表示（如果有多个值。请检查更新的答案，并告诉我是否有任何问题哇！非常感谢Paul，这非常有效。我感谢您的帮助。非常简单！@QHarr，谢谢。我的代码与OP的示例非常相似，其中没有可能的子字符串不匹配。当然，它可以轻松地增强为h。）我正忙着写一个正则表达式，然后你的答案出现了。这是一个“无聊”的时刻……@QHarr&DisplayName-你们两个在这里真是太巧了，我只是在问“谁拥有所有的标签徽章iin（VBA、Excel、Excel VBA），并且回答了今年最相关的问题？”…而且你们两人在赛德的第1场比赛中几乎平手（）统计数据截至周一，所以从那时起平衡可能会出现倾斜then@QHarr在我看来，你说了一些与我“竞争”的类似的话，然后以2:1的回答率把我甩了……小心点，他只是想让你放松警惕。

Public Sub Main()
    Dim cell As Range, cell2 As Range
    For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A2:A20")
        For Each cell2 In cell.Offset(, 1).Resize(, 3)
            If Instr(cell.Value, cell2.Value) > 0 Then cell2.Interior.ColorIndex = 3
        Next
    Next 
End Sub

Public Sub Main()
    Dim cell As Range
    With ThisWorkbook.Worksheets("Sheet1")
        For Each cell In .Range("B:D").SpecialCells(xlCellTypeConstants)
            If Instr(.Cells(cell.Row,1).Value, cell.Value) > 0 Then cell.Interior.ColorIndex = 3
        Next
    End With 
End Sub