Question

我有以下代码执行以下操作：

检查Col K中的日期
如果日期是星期日，那么＆＃34; P＆＃34; col有文本＆＃34;移动到SA＆＃34;，它不会将Col M中的值用红色着色。

示例格式：M/D/YYY TIME - 1/22/2017 21:00

我想要添加到上述逻辑中的是：

代码还应检查星期六以及时间如果星期六的时间超过下午6点（18:00），那么它不应该为Col M中的值着色。

我只需要在我的代码中添加这个条件。

Sub SundayDatefilter()

Dim r, lastrow, remainingDay As Long

lastrow = Range("M:P").Cells(Rows.count, "A").End(xlUp).Row

Application.ScreenUpdating = False

   For r = 2 To lastrow
      remainingDay = 0

     If Weekday(Range("K" & r).Value, vbSunday) = 1 Then
        remainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

        If InStr(1, Range("P" & r).Text, "*Moved to SA*", vbTextCompare) > 0 Then
           If Range("M" & r) - remainingDay >= 1 Then
              Range("M" & r).Cells.Font.ColorIndex = 3
           Else
              Range("M" & r).Cells.Font.ColorIndex = 0
           End If
        End If
     End If
  Next r
  Application.ScreenUpdating = True

End Sub

Answer 1

逻辑上，没有必要添加该测试：

您的第一个测试是检查日期是否为SUNDAY
如果不是，那么你就不会再进一步了解那一行
因此，如果日期是星期六，您将不会为任何颜色着色！

我修改了一下你的代码：

当您宣布变量r和lastrow为Variant时！
我添加了对工作表的引用（此处为Sheet1）以提高稳健性和性能

这是你的代码：

Sub SundayDatefilter()
Application.ScreenUpdating = False
Dim wS As Worksheet, _
    r As Long, _
    LastRow As Long, _
    RemainingDay As Long

Set wS = ThisWorkbook.Sheets("Sheet1")
With wS
    LastRow = .Range("M:P").Cells(.Rows.Count, "A").End(xlUp).Row
   For r = 2 To LastRow
      RemainingDay = 0
        If Weekday(.Range("K" & r).Value, vbSunday) = 1 Then
            RemainingDay = Round((24 - Format(TimeValue(.Range("K" & r)), "h")) / 24, 1)

            If InStr(1, .Range("P" & r).Text, "*Moved to SA*", vbTextCompare) > 0 Then

                If .Range("M" & r) - RemainingDay >= 1 Then
                    .Range("M" & r).Cells.Font.ColorIndex = 3
                Else
                    .Range("M" & r).Cells.Font.ColorIndex = 0
                End If
            End If
        End If
        If Weekday(.Range("K" & r).Value, vbSunday) = 7 and TimeValue(.Range("K" & r))>TimeValue("18:00:00") Then
            RemainingDay = Round((24 - Format(TimeValue(.Range("K" & r)), "h")) / 24, 1)

            If InStr(1, .Range("P" & r).Text, "*Moved to SA*", vbTextCompare) > 0 Then

                If .Range("M" & r) - RemainingDay >= 1 Then
                    .Range("M" & r).Cells.Font.ColorIndex = 3
                Else
                    .Range("M" & r).Cells.Font.ColorIndex = 0
                End If
            End If
        End If
    Next r
End With 'wS
Application.ScreenUpdating = True
End Sub

忽略VBA中的星期六值

1 个答案: