满足条件时为整行着色

Question

代码的作用是如果 Col X 和 Y 包含日期，则将整行涂成黄色。
如果只有 X 包含日期，则将整行涂成红色。
但如果 X 和 Y 为空，则将其涂成绿色。在最后一个条件下。

如果满足条件，我无法让我的代码为整行着色。

Dim i As Long
Dim lrX As Long     'last row with a filled cell in column X
Dim lrY As Long     'last row with a filled cell in column Y
Dim lr As Long      'max of lrX and lrY
Dim ws As Worksheet

Set ws = ActiveSheet

lrX = Range("X" & Rows.Count).End(xlUp).Row
lrY = Range("Y" & Rows.Count).End(xlUp).Row
lr = Application.WorksheetFunction.Max(lrX, lrY)

For i = 2 To lr     'my data starts in row 1, otherwise change this
    If IsDate(ws.Range("X" & i).Value) Then
        If IsDate(ws.Range("Y" & i).Value) Then
          ws.Range("a" & i).EntireRow.Interior.Color = vbYellow       'both X and Y have a date value, so Yellow
        Else
          ws.Range("a" & i).EntireRow.Interior.Color = vbRed        'only X has a date
        If (.Cells(i, 24).Value = "") And _
        (.Cells(i, 25).Value = "") Then
         .Rows(i).EntireRow.Interior.ColorIndex = 4  ' 4: Green
        End If
    End If

Next i

Answer 1

你也可以用公式做这样的事情。你可以修改函数来处理更多的逻辑和颜色。

如果表达式为真，这会将行着色为绿色。您将颜色指定为 RGB。

=ColorRowIF(A1=B1, 1, 181, 0)

或者在你的情况下

=ColorRowIF(IsDate(A1), 1, 181, 0)

Public Function ColorRowIF(Condition As Boolean, r As Integer, g As Integer, b As Integer) As String
    Dim row As Integer
    row = Application.Caller.row

    If Condition = True Then
        ActiveSheet.Evaluate "ColorRow(" & row & ", " & r & ", " & g & ", " & b & ")"
    Else
        ActiveSheet.Evaluate "RemoveRowColor(" & row & ")"
    End If

    ColorRowIF = Condition
End Function


Public Sub ColorRow(row As Integer, r As Integer, g As Integer, b As Integer)

    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Rows(row).Interior.Color = RGB(r, g, b)

End Sub

Public Sub RemoveRowColor(row As Integer)

    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ws.Rows(row).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub


Function IsDate(CellDate As Date) As Boolean
    If CellDate >= 1 And CellDate <= #12/31/2199# Then
    ' 1 is equal to January 1, 1900
        IsDate = True
    Else
        IsDate = False
        End If
End Function

Answer 2

您的代码不起作用的几个原因：

1. 您有If (.Cells(i, 24).Value = "") And (.Cells(i, 25).Value = "") Then，但缺少ws 对象的With 语句。
2. 你有 3 x If，只有 2 x End If。
3. 您将If IsDate(ws.Range("X" & i).Value) Then 作为第一个If 条件，因此如果“X”列中的值不是日期，则保留所有循环（因为正在检查您拥有的其他2 x Ifs仅当您首先通过此If)。

试试下面的代码（代码cmets里面的解释）：

Dim i As Long
Dim lrX As Long     'last row with a filled cell in column X
Dim lrY As Long     'last row with a filled cell in column Y
Dim lr As Long      'max of lrX and lrY
Dim ws As Worksheet

Set ws = ActiveSheet

lrX = Range("X" & Rows.Count).End(xlUp).Row
lrY = Range("Y" & Rows.Count).End(xlUp).Row
lr = Application.WorksheetFunction.Max(lrX, lrY)

With ws ' <-- added the with statement
    For i = 2 To lr     'my data starts in row 1, otherwise change this
        ' first check if both cells are empty
        If .Range("X" & i).Value = "" And .Range("Y" & i).Value = "" Then
            .Rows(i).Interior.ColorIndex = 4  ' 4: Green
        ElseIf IsDate(.Range("X" & i).Value) Then
            If IsDate(.Range("Y" & i).Value) Then
                .Rows(i).Interior.Color = vbYellow  'both X and Y have a date value, so Yellow
            Else
                .Rows(i).Interior.Color = vbRed  'only X has a date
            End If
        End If
    Next i
End With