使用date和ID合并列的macros，并突出显示它们
我有列A，B，D，E列A包含ID和列B只包含匹配的ID。 （有时B列中没有ID），D列包含源date，E列包含开始date（E列有时没有任何date）
我需要比较date和项目已经开始的f栏粘贴结果。
我有4个案件。
案例1.如果巫师的date<4周的开始date，然后按时打印项目。
情况2：如果来源date大于8周的开始date，则打印项目延迟。
情况3：如果在列A和列B中存在Id并且在列E中没有find开始date，则应该打印剩余的项目。
案例4：列B中没有ID，没有find源date，则不进行打印。
我已经编码比较date，但我很惊讶，我应该如何与案例3中的Id进行比较。
Sub dateCompare() Dim r As Long, zLastRow As Long Dim zWeeks As Double, zcolour As Long Dim Ztext As String zLastRow = Cells(Rows.Count, "D").End(xlUp).Row For r = 2 To zLastRow If Len(Trim(Cells(r, "E"))) = 0 Then Cells(r, 6) = " Remaining" Cells(r, 6).Interior.Color = vbYellow Cells(r, 7) = "Yellow" Else zWeeks = DateDiff("w", Cells(r, "D"), Cells(r, "E")) Select Case zWeeks Case Is > 8 zcolour = vbRed Ztext = "Delayed " & Int(zWeeks) & " weeks" Cells(r, 7) = "Red" Case Is < 4 zcolour = vbGreen Ztext = " On- Time" Cells(r, 7) = " Green" Case 4 To 8 zcolour = vbYellow Ztext = "Remaining" Cells(r, 7) = "Yellow" Case Else zcolour = none Ztext = " check for dates" End Select Cells(r, "F").Interior.Color = zcolour Cells(r, "F") = Ztext End If Next r End Sub 案例1.如果巫师的date<4周的开始date，然后按时打印项目。
=IF(IFERROR(DATEDIF(D2,E2,"d")/7,5)<4,"Project in Time","-")
情况2：如果源date大于8周开始date，则打印项目延迟。
=IF(IFERROR(DATEDIF(E2,D2,"d"),7)/7>8,"Project Delay","-")
情况3：如果在列A和列B中存在Id并且在列E中没有find开始date，则应该打印剩余的项目。
=IF(AND(A2<>"",B2<>""),IF(E2="","Project remaining",""),"")
案例4：列B中没有ID，没有find源date，则不进行打印。
=IF(AND(B2="",D2=""),"Nothing","")
现在你有4个公式。 只要join他们，你会得到
=IF(AND(B2="",D2=""),"Nothing",IF(AND(A2<>"",B2<>""),IF(E2="","Project remaining",IF(IFERROR(DATEDIF(E2,D2,"d"),7)/7>8,"Project Delay",IF(IFERROR(DATEDIF(D2,E2,"d")/7,5)<4,"Project in Time",""))),""))
要在VBA中使用，只需执行此操作
With Range("F2:F" & zLastRow) .Formula = "=IF(AND(B2="""",D2=""""),""Nothing"",IF(AND(A2<>"""",B2<>"""")," & _ "IF(E2="""",""Project remaining"",IF(IFERROR(DATEDIF(E2,D2,""d"")," & _ "7)/7>8,""Project Delay"",IF(IFERROR(DATEDIF(D2,E2,""d"")/7,5)<4" & _ ",""Project in Time"",""""))),""""))" .Value = .Value End With
testing以下情况
截图
用于testing的代码
Sub Sample() zLastRow = 5 With Range("F2:F" & zLastRow) .Formula = "=IF(AND(B2="""",D2=""""),""Nothing"",IF(AND(A2<>"""",B2<>"""")," & _ "IF(E2="""",""Project remaining"",IF(IFERROR(DATEDIF(E2,D2,""d"")," & _ "7)/7>8,""Project Delay"",IF(IFERROR(DATEDIF(D2,E2,""d"")/7,5)<4" & _ ",""Project in Time"",""""))),""""))" .Value = .Value End With End Sub
注意 ：我相信可以有一个比我想出的更好的公式，但是你得到了在VBA中使用公式的要点。 它减less了代码行。
编辑 ：
其实第四个条件并不重要。 这个公式也可以工作
=IF(AND(A2<>"",B2<>""),IF(E2="","Project remaining",IF(IFERROR(DATEDIF(E2,D2,"d"),7)/7>8,"Project Delay",IF(IFERROR(DATEDIF(D2,E2,"d")/7,5)<4,"Project in Time",""))),"")
所以VBA相当于
Sub Sample() zLastRow = 5 With Range("F2:F" & zLastRow) .Formula = "=IF(AND(A2<>"""",B2<>""""),IF(E2="""",""Project remaining""," & _ "IF(IFERROR(DATEDIF(E2,D2,""d""),7)/7>8,""Project Delay""," & _ "IF(IFERROR(DATEDIF(D2,E2,""d"")/7,5)<4,""Project in Time"",""""))),"""")" .Value = .Value End With End Sub
如果你想按照你的方式，那么做到这一点
Sub Sample() Dim ws As Worksheet Dim lRow As Long, i As Long Dim zWeeks As Double, zcolour As Long Dim Ztext As String Set ws = Sheet1 '<~~ Change this to the relevant code With ws lRow = .Range("D" & .Rows.Count).End(xlUp).Row For i = 2 To lRow zWeeks = DateDiff("ww", .Range("E" & i).Value, .Range("D" & i).Value) If .Range("A" & i).Value <> "" And .Range("B" & i).Value <> "" And .Range("E" & i).Value = "" Then Ztext = "Project remaining" zcolour = vbYellow ElseIf zWeeks < 4 Then Ztext = "Project on time" zcolour = vbGreen ElseIf zWeeks > 8 Then Ztext = "Project delayed" zcolour = vbRed End If With .Range("F" & i) .Value = Ztext .Interior.Color = zcolour End With Next i End With End Sub
注意：几周以来，您必须在DateDiff使用ww而不是w
截图
If Cells(r, "A") <> "" And Cells(r, "B") <> "" And Cells(r, "E") = "" Then ' do something End If