Usuwanie całych zduplikowanych wierszy z warunkami i

Question

Mam dane z duplikatami (kolumna "c") i chcę usunąć wiersz z liczbami w kolumnie "D". ale tylko dla duplikatów z datami dziwne, jak widać na zdjęciu

to jest im kod za pomocą, ale nie wiem jak usunąć wiersz z danymi w „D” i jest duplikatem

Sub del_doops() 
    Dim RowNdx As Long 
    Dim RowNdx2 As Long 

    For RowNdx = Range("A1:f1").End(xlDown).Row To 2 Step -1 
     For RowNdx2 = RowNdx - 1 To 1 Step -1 'Begin at one above RowNdx 

      If Cells(RowNdx, "b").Value = Cells(RowNdx2, "b").Value And _ 
       Cells(RowNdx, "C").Value = Cells(RowNdx2, "C").Value And _ 
       Cells(RowNdx, "E").Value = Cells(RowNdx2, "E").Value And _ 
       Cells(RowNdx, "F").Value <> Cells(RowNdx2, "F").Value Then 
       Rows(RowNdx2).Delete 'this is where i need help 
      End If 

     Next RowNdx2 
    Next RowNdx 

End Sub 

Answer 1

Zmień Sheet1 nazwy arkusza w Set wS = ThisWorkbook.Sheets("Sheet1"):

Sub del_doops() 
Dim RowNdx As Long 
Dim RowNdx2 As Long 
Dim wS As Worksheet 

Set wS = ThisWorkbook.Sheets("Sheet1") 
With wS 
    For RowNdx = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1 
     For RowNdx2 = RowNdx - 1 To 1 Step -1 'Begin at one above RowNdx 
      If .Cells(RowNdx, "B").Value = .Cells(RowNdx2, "B").Value And _ 
        .Cells(RowNdx, "C").Value = .Cells(RowNdx2, "C").Value And _ 
        .Cells(RowNdx, "E").Value = .Cells(RowNdx2, "E").Value And _ 
        .Cells(RowNdx, "F").Value <> .Cells(RowNdx2, "F").Value Then 
       If .Cells(RowNdx, "D").Value <> vbNullString Then 
        .Rows(RowNdx).Delete 
       Else 
        If .Cells(RowNdx2, "D").Value = vbNullString Then .Rows(RowNdx2).Delete 
       End If 
      End If 
     Next RowNdx2 
    Next RowNdx 
End With 'wS 
End Sub 

Answer 2

Sub del_doops() 
Dim RowNdx As Long 
Dim RowNdx2 As Long 
For RowNdx = Range("A1:f1").End(xlDown).Row To 2 Step -1 
    For RowNdx2 = RowNdx - 1 To 1 Step -1 'Begin at one above RowNdx 
     If Cells(RowNdx, "B").Value = Cells(RowNdx2, "B").Value And _ 
     Cells(RowNdx, "C").Value = Cells(RowNdx2, "C").Value And _ 
     Cells(RowNdx, "E").Value = Cells(RowNdx2, "E").Value And _ 
     Cells(RowNdx, "F").Value = Cells(RowNdx2, "F").Value Then 
      If Cells(RowNdx, "D").Value = vbNullString And _ 
      Cells(RowNdx2, "D").Value <> vbNullString Then 
       Rows(RowNdx2).Delete 
      Else 
       Rows(RowNdx).Delete 
      End If 
     End If 
    Next RowNdx2 
Next RowNdx 
End Sub