宏，用于将列与日期和Id组合起来并突出显示它们

Question

我有A，B，D，E列A包含ID，B列conatins只包含匹配的ID。(有时在B列中没有ID )，D列包含源日期，E列包含开始日期。(E列有时没有任何日期)

我需要比较日期和粘贴结果在项目已经启动的第f栏中。

我有四个箱子。

如果sorce日期小于开始日期的4周，则按时间打印项目。

案例2:如果源日期是开始日期的8周以上，那么打印项目延迟。

案例3:如果A和B列中有Id，而E列中没有找到开始日期，那么它应该打印ProjectS残留物。

案例4:B列中没有id，也没有找到源日期，然后什么也不打印。

我已经为比较日期编写了代码，但我很惊讶如何在第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

Answer 1

如果sorce日期小于开始日期的4周，则按时间打印项目。

=IF(IFERROR(DATEDIF(D2,E2,"d")/7,5)<4,"Project in Time","-")

案例2:如果源日期是开始日期的8周以上，那么打印项目延迟。

=IF(IFERROR(DATEDIF(E2,D2,"d"),7)/7>8,"Project Delay","-")

案例3:如果A和B列中有Id，而E列中没有找到开始日期，那么它应该打印ProjectS残留物。

=IF(AND(A2<>"",B2<>""),IF(E2="","Project remaining",""),"")

案例4:B列中没有id，也没有找到源日期，然后什么也不打印。

=IF(AND(B2="",D2=""),"Nothing","")

现在你有了4个公式。只要加入他们，你就会得到

=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

使用下列方案进行测试

截图

​

​

用于测试的代码

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中使用公式的要点。它减少了代码行。

编辑

实际上，第四个条件并不重要。这个公式也可以工作。

=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

截图

​

​

Answer 2

  If Cells(r, "A") <> "" And Cells(r, "B") <> "" And Cells(r, "E") = "" Then
    ' do something

  End If