比较两列中的日期并突出显示单元格

Question

我正在比较两列（D 和 E）中的两个日期。 D 列中的日期是源日期，E 列中的日期是项目的开始日期。

我将两个日期的差异计算为周，并将结果粘贴到 F 列并相应地突出显示。

我有 4 个案例：

• 案例 1：如果采购日期比开始日期晚 > 4 周，则状态为“项目延迟”。
• 案例 2：如果源日期距离开始日期不到 2 周，则状态为“项目准时”。
• 案例 3：如果源日期为 开始日期的 2 周，则状态为“项目剩余”。

我已经实现了树案例。

• 案例 4：在某些情况下，E 列可能没有任何日期并且为空。在这种情况下，我想要一个 if 案例，上面写着“Project not started”。

我将它作为 Null 进行了尝试，但我不知道为什么这种情况 4 不起作用。

Sub dateCompare()
    zLastRow = Range("D" & Rows.Count).End(xlUp).Row   'last data row

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For r = 2 To zLastRow
        zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7   'date difference in weeks

        Select Case zWeeks
            Case Is > 4                                'later than 4 weeks
                zColour = vbRed
                zText = "Project delayed " & Int(zWeeks) & " weeks"

            Case 2 To 4                                'between 2 and 4 weeks
                zColour = vbYellow
                zText = "Project ongoing"

            Case Is < 2                                'less than 2 weeks
                zColour = vbGreen
                zText = "Project On-Time"

            Case Else                                  'in case of duff data..
                zColour = xlNone
                zText = " check dates"
        End Select

        Cells(r, "D").Interior.Color = zColour         'set cell background colour
        Cells(r, "F") = zText                          'set project status
    Next
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
End Sub

请帮我解决这个问题。
问候， 米克兹

Answer 1

检查：

Sub dateCompare()
zLastRow = Range("D" & Rows.Count).End(xlUp).Row    'last data row

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For r = 2 To zLastRow
    If IsEmpty(Cells(r, "E").Value) Then 'check if column is empty
        zColour = xlNone
        zText = " check dates"
    else
        zWeeks = (Cells(r, "E") - Cells(r, "D")) / 7        'date difference in weeks

        Select Case zWeeks
            Case Is > 4                                         'later than 4 weeks
               zColour = vbRed
               zText = "Project delayed " & Int(zWeeks) & " weeks"
            Case 2 To 4                                         'between 2 and 4 weeks
                zColour = vbYellow
                zText = "Project ongoing"
            Case Is < 2                                         'less than 2 weeks
                zColour = vbGreen
                zText = "Project On-Time"
        End Select
    End if

    Cells(r, "D").Interior.Color = zColour              'set cell background colour
    Cells(r, "F") = zText                               'set project status

Next
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

End Sub