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

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

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

我有4例与我：

• 案例1：如果采购date大于4周开始date，则状态为“项目延迟” 。
• 情况2：如果源date<开始date的2周，则状态为“ 项目准时 ”。
• 情况3：如果来源date<4周，开始date> 2周，则状态为“ 项目剩余 ”。

我已经实现了树的情况。

• 案例4：在某些情况下，列E可能没有任何date而且是空的。 在这种情况下，我想有一个如果说“ 项目未开始 ”的情况。

我试过它为空，但我不明白，为什么这个案件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 

请帮我解决这个问题。
问候，Mikz

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