宏/VBA：基于 2 个条件突出显示行

Question

目标是突出显示满足两个不同条件的行：

1. 如果 A 列等于前一个工作日（考虑到参考表中提到的假期）
2. 如果 B 列不等于“AA”

我有以下代码，但无法突出显示适当的行（由于未满足条件 #1，没有突出显示行）：

Sub code()

    Dim lrow As Long
    lrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lrow
    If Cells(i, "A").Value = "=WORKDAY(today(),-1,Reference!$A$2:$A$12)" And Cells(i, "B").Value <> "AA"  Then Cells(i, 1).EntireRow.Interior.ColorIndex = 6
    Next i
  
End Sub

Answer 1

你可以试试这个：

Option Explicit

Sub code()

    Dim i As Long, lrow As Long
    Dim objRangeHolidays As Range
    
    Set objRangeHolidays = Worksheets("Reference").Range("$A$2", "$A$12")
    
    lrow = Cells(rows.Count, "A").End(xlUp).row
    
    For i = 2 To lrow
      If CDate(Cells(i, "A").Value) = CDate(Application.WorksheetFunction.WorkDay(Date, -1, objRangeHolidays)) And Cells(i, "B").Value <> "AA" Then
        Cells(i, 1).EntireRow.Interior.ColorIndex = 6
      End If
    Next i
  
    Set objRangeHolidays = Nothing
  
End Sub

您的原始代码不起作用，因为"=WORKDAY(today(),-1,Reference!$A$2:$A$12)" 是 VBA 上的文字字符串，而不是函数调用。

我们使用CDate() 函数使我们的单元格值与WorksheetFunction.Workday() 函数相当。

WorksheetFunction.Today() 与 VBA 中的Date() 相同。

objRangeHolidays 保存在Reference 表中定义的假期。

这是我的测试结果：

Answer 2

突出显示整行

• 调整常量部分中的值。

Option Explicit

Sub highlightPreviousWorkday()
    
    ' Source
    Const sName As String = "Sheet1"
    Const sFirst As String = "A2"
    Const sCritCol As String = "B"
    Const sCriteria As String = "AA"
    Const sColorIndex As Long = 6
    ' Holiday
    Const hName As String = "Reference"
    Const hFirst As String = "A2"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    wb.Activate ' `Evaluate` will fail if not active.
    
    ' Source
    Dim srg As Range
    With wb.Worksheets(sName).Range(sFirst)
        Dim slCell As Range
        Set slCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If slCell Is Nothing Then Exit Sub
        Set srg = .Resize(slCell.Row - .Row + 1)
    End With
    
    ' Holiday
    Dim Holiday As String
    With wb.Worksheets(hName).Range(hFirst)
        Dim hlCell As Range
        Set hlCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not hlCell Is Nothing Then
            Holiday = ",'" & hName & "'!" _
                & .Resize(hlCell.Row - .Row + 1).Address
        End If
    End With
    
    ' Evaluation
    Dim evDate As Variant
    evDate = Evaluate("WORKDAY(TODAY(),-1" & Holiday & ")")
    
    ' Combine
    Dim drg As Range
    If VarType(evDate) = vbDouble Then
        Dim sCell As Range
        Dim sValue As Variant
        Dim sString As String
        For Each sCell In srg.Cells
            sValue = sCell.Value
            If VarType(sValue) = vbDate Then
                If CDbl(sValue) = evDate Then
                    sString = CStr(sCell.EntireRow.Columns(sCritCol).Value)
                    If sString <> sCriteria Then
                        Set drg = getCombinedRange(drg, sCell)
                    End If
                End If
            End If
        Next sCell
    End If
  
    ' Color
    Application.ScreenUpdating = False
    srg.EntireRow.Interior.ColorIndex = xlNone
    If Not drg Is Nothing Then
        drg.EntireRow.Interior.ColorIndex = sColorIndex
    End If
    Application.ScreenUpdating = True
     
End Sub

Function getCombinedRange( _
    ByVal BuiltRange As Range, _
    ByVal AddRange As Range) _
As Range
        If BuiltRange Is Nothing Then
            Set getCombinedRange = AddRange
        Else
            Set getCombinedRange = Union(BuiltRange, AddRange)
        End If
End Function