VBA in Excel, um Spalten mit verschiedenen Fällen zu vergleichen

Question

Ich vergleiche die Spalten mit Daten und Zahlen. Ich habe insgesamt 8 Spalten (A-H). Spalte A und B enthält Zahlen. (In einigen Fällen ist Spalte B leer). Spalte D (sdate) und E (Ldate) enthält Daten. (In einigen Fällen ist Spalte E leer).

Ich habe jetzt 4 Fälle mit mir.

Fall 1 ist, wenn sdate < 2 Wochen von Ldate, dann druckt ontime.

case2 ist sdate> 4weeks von Ldate, Druckverzögerung.

Fall 3 ist sdate ist < 4weeks und> 2weeks von Ldate, dann Projekt remaning.with Fall 3, gibt es eine andere Bedingung, dass, wenn Spalte A, B und D vorhanden sind, aber kein Datum in Spalte E, Es sollte immer noch gedruckt werden.

case4: Spalte A enthält Zahlen, Spalte B hat keine Zahlen, Spalte D hat Datum und Spalte E hat kein Datum dann sollte es leer gelassen werden.

2 Experten des Forums, leitete mich, um die Kriterien zu erreichen, aber mit dem unten stehenden Code, gibt es einen Fehler, dass es Case4 nicht zufrieden stellend.

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 = Sheets("Preparation Sheet") 

    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 = "remaining" 
       zcolour = vbYellow 
       Cells(i, 7) = "Yellow" 
      ElseIf zWeeks < 2 Then 
       Ztext = " on time" 
       zcolour = vbGreen 
       Cells(i, 7) = "Green" 
      ElseIf zWeeks > 4 Then 
       Ztext = "delayed" 
       zcolour = vbRed 
       Cells(i, 7) = "Red" 
       ElseIf zWeeks > 2 < 4 Then 
       Ztext = "remaining" 
       zcolour = vbYellow 
       Cells(i, 7) = "Yellow" 

      End If 


      With .Range("F" & i) 
       .Value = Ztext 
       .Interior.Color = zcolour 
      End With 
     Next i 
    End With 
End Sub 

Answer 1

eine neue Bedingung hinzufügen nac r die erste, die überprüft, ob der Wert auf Col.B und E Leerzeichen sind.

ElseIf .Range("B" & i).value = "" And .Range("E" & i).value = "" Then 
     GoTo nextrow 

Fügen Sie dann die Beschriftung vor dem Ende der Schleife hinzu. Dies wird den anderen Zustand übergehen und in die nächste Zeile bewegen:

nextrow: 
    Next i 

Answer 2

versuchen, diese Zeilen vor Ende hinzufügen, wenn

ElseIf IsNumeric(Range("A" & i).Value) And (Not IsNumeric(Range("A" & i).Value)) And IsDate(Range("D" & i).Value) And Range("E" & i).Value = "" Then 
Ztext = "" 
zcolour = vbYellow 
Cells(i, 7) = "Yellow" 

Answer 3

dieses Versuchen

Hinweis: nicht

getestet

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 = Sheets("Preparation Sheet") 

    With ws 
     lRow = .Range("D" & .Rows.Count).End(xlUp).Row 

     For i = 2 To lRow 
       lDate = .Range("E" & i).Value 
       sDate= .Range("D" & i).Value 
      zWeeks = DateDiff("ww",sDate , lDate) 

      If .Range("A" & i).Value <> "" And .Range("B" & i).Value <> "" And .Range("E" & i).Value = "" Then 
       Ztext = "remaining" 
       zcolour = vbYellow 
       Cells(i, 7) = "Yellow" 
      ElseIf .Range("A" & i).Value <>"" And .Range("B" & i).Value = "" And IsDate(sDate) And Ldate = "" Then 
       Ztext = "" 
       zcolour = vbYellow 
       Cells(i, 7) = "Yellow" 
      ElseIf zWeeks < 2 Then 
       Ztext = " on time" 
       zcolour = vbGreen 
       Cells(i, 7) = "Green" 
      ElseIf zWeeks > 4 Then 
       Ztext = "delayed" 
       zcolour = vbRed 
       Cells(i, 7) = "Red" 
      ElseIf zWeeks > 2 < 4 Then 
       Ztext = "remaining" 
       zcolour = vbYellow 
       Cells(i, 7) = "Yellow" 

      End If 


      With .Range("F" & i) 
       .Value = Ztext 
       .Interior.Color = zcolour 
      End With 
     Next i 
    End With 
End Sub