Vergleichen von Daten in zwei Spalten und Markieren der Zelle

Question

Ich vergleiche die beiden Daten in den beiden Spalten (D und E). Die Daten in Spalte D sind Quelldaten und die Daten in Spalte E sind das Startdatum des Projekts.

Ich berechne die Differenz in zwei Daten als Wochen und fügen Sie das Ergebnis in die Spalte F und markieren Sie es entsprechend.

Ich habe 4 Fälle mit mir:

• Fall 1: Wenn das Sourcing Datum> 4 Wochen Startdatum dann der Status "Projekt verzögert".
• Fall 2: Wenn das Quelldatum < 2 Wochen nach dem Startdatum lautet, lautet der Status "Projekt pünktlich".
• Fall 3: Wenn das Quelldatum < 4 Wochen ist,> 2 Wochen des Startdatums ist der Status "Projekt übrig".

Ich habe die Baum Fälle erreicht.

Fall 4: Es besteht die Möglichkeit, dass die Spalte E in einigen Fällen kein Datum hat und leer ist. In dieser Situation hätte ich gerne einen falls, der sagt "Projekt nicht gestartet".

Ich versuchte es als Null, aber ich konnte nicht herausfinden, warum dieser Fall 4 nicht funktionierte.

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 

Bitte helfen Sie mir, dieses Problem zu lösen.
Grüße, Mikz

Answer 1

Check:

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