Supprimer dans une liste les nombres annulés par un nombre négatif

Sub test()
Dim c As Range, d As Range, Zone As Range
Application.ScreenUpdating = False
Set Zone = Range("D2:D" & Range("D65000").End(xlUp).Row)
For Each c In Zone 'pour chaque cellule de la colonne D
  If c < 0 Then ' si elle est < à 0
    Set d = Zone.Find(what:=-c, LookIn:=xlValues, lookat:=xlWhole) ' On cherche son opposé dans la colonne
    Do While Not d Is Nothing ' Si il existe et tant qu'il existe
      d.Offset(, 1) = 1: d = 0 ' On marque avec un 1 à côté, on remplace cellule et son opposé par 0
      c.Offset(, 1) = 1
      Set d = Zone.Find(what:=-c, LookIn:=xlValues, lookat:=xlWhole)
    Loop
  End If
Next c
Range("E:E").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'on efface tout ce qui a été marqué avec des 1 en colonne E
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
For lig = [D65536].End(3).Row To 2 Step -1
If Cells(lig, 4) < 0 Then
k = Application.Match(Abs(Cells(lig, 4)), Range("D2:D" & [D65536].End(3).Row), 0)
If IsNumeric(k) Then Rows(lig).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

=NB.SI(D:D;D2)-NB.SI(D:D;-D2)

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
For lig = [D65536].End(3).Row To 2 Step -1
If Cells(lig, 4) < 0 Then
x = Cells(lig, 4)
k = Application.Match(Abs(x), Range("D2:D" & [D65536].End(3).Row), 0)
If IsNumeric(k) Then
Rows(lig).Delete
Rows(Application.Match(Abs(x), Range("D2:D" & [D65536].End(3).Row), 0) + 1).Delete
lig = lig - 2
End If
End If
Next
Application.ScreenUpdating = True
End Sub