如果相邻单元格包含特定文本，则查找并突出显示包含文本的单元格

Question

我想创建一个Sub，如果相邻单元格包含单词“ SAMPLE”，则其中包含数字0的单元格会突出显示。我之后找不到任何代码来建模我的模型，因此非常感谢链接！这是单元格布局的示例：我以蓝色手动突出显示了目标单元格以指出它们。

这是我的代码：

'PURPOSE: Find SAMPLES that contain zero N/Mol and highlight the cell yellow
Sub Find_Highlight_ZeroNitrogenSAMPLE()
Dim WS As Worksheet
Dim Match As Range
Dim FirstAddress As Variant

Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")
Set Match = WS.Cells.Find(What:="0", LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)
    'Find cells containing zero

    If Not Match Is Nothing And Match.Offset(, 3) = "SAMPLE" Then
    'Highlight If cell three columns over is SAMPLE
    FirstAddress = Match.Address
        Do
        Match.Interior.Color = RGB(255, 255, 0)
        'Highlight cell containing zero
        Set Match = WS.Cells.FindNext(Match)
        Loop While Not Match Is Nothing And Match.Address <> FirstAddress
    End If
End Sub

我不确定是否要完全将其标准化，有任何提示吗？

Answer 1

同意Scott的观点，CF是可行的方法，但这是对Find方法的改编。

您还可以在开始时检查是否有满足两个条件的行。

Sub Find_Highlight_ZeroNitrogenSAMPLE()

Dim WS As Worksheet
Dim Match As Range
Dim FirstAddress As String 'not variant

Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")

'first check there are any cases before proceeding
If WorksheetFunction.CountIfs(WS.Range("T:T"), 0, WS.Range("W:W"), "SAMPLE") = 0 Then
    MsgBox "No instances of 0 and SAMPLE"
    Exit Sub
End If

Set Match = WS.Cells.Find(What:="0", LookIn:=xlValues, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=True, SearchFormat:=False) 'probably don't need quotes around "0"

'Find cells containing zero
If Not Match Is Nothing Then
    FirstAddress = Match.Address
    Do
        If Match.Offset(, 3).Value = "SAMPLE" Then
            Match.Interior.Color = RGB(255, 255, 0)
            'Highlight cell containing zero
        End If
        Set Match = WS.Cells.FindNext(Match)
    Loop While Match.Address <> FirstAddress 'stop as soon as back to first case, Match will never be Nothing
End If

End Sub