Suppression doublons dans colonnes sous conditions

Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Range("B" & Rows.Count).End(xlUp).Row
xx = Range("C" & Rows.Count).End(xlUp).Row
If x > xx Then
  derlintab = x
Else
  derlintab = xx
End If
ReDim tab_nom(0)
For n = 2 To derlintab
  If Range("A" & n) <> "" Then
    tab_nom(UBound(tab_nom)) = n
    ReDim Preserve tab_nom(UBound(tab_nom) + 1)
  End If
Next
For n = LBound(tab_nom) To UBound(tab_nom) - 1
If n <> UBound(tab_nom) - 1 Then
 fin = tab_nom(n + 1)
Else
 fin = derlintab + 1
End If
  Set jour = Range("B" & tab_nom(n) + 1 & ":B" & fin - 1)
  Set nuit = Range("C" & tab_nom(n) + 1 & ":C" & fin - 1)
  For Each cel In jour
    For Each cel1 In nuit
      If cel.Value <> 0 And cel1.Value <> 0 And cel.Value <> "" And cel1.Value <> "" And cel.Value = cel1.Value And cel.Interior.ColorIndex = xlNone And cel1.Interior.ColorIndex = xlNone Then
        cel.Interior.ColorIndex = 3
        cel1.Interior.ColorIndex = 3
      End If
    Next
  Next
Next
For n = derlintab To 1 Step -1
  If Range("B" & n).Interior.ColorIndex = 3 Then Rows(n).Delete
  If Range("C" & n).Interior.ColorIndex = 3 Then Rows(n).Delete
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub test1()
Dim zone As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Range("B" & Rows.Count).End(xlUp).Row
xx = Range("C" & Rows.Count).End(xlUp).Row
If x > xx Then
  derlintab = x
Else
  derlintab = xx
End If
ReDim tab_nom(0)
For n = 2 To derlintab
  If Range("A" & n) <> "" Then
    tab_nom(UBound(tab_nom)) = n
    ReDim Preserve tab_nom(UBound(tab_nom) + 1)
  End If
Next
ReDim tabres(0)
For n = LBound(tab_nom) To UBound(tab_nom) - 1
 If n <> UBound(tab_nom) - 1 Then
   fin = tab_nom(n + 1)
  Else
   fin = derlintab + 1
 End If
 jour = Range("B" & tab_nom(n) + 1 & ":B" & fin - 1)
 nuit = Range("C" & tab_nom(n) + 1 & ":C" & fin - 1)


 For m = LBound(jour, 1) To UBound(jour, 1)
  For p = LBound(nuit, 1) To UBound(nuit, 1)
   If jour(m, 1) <> "" And nuit(p, 1) <> "" And jour(m, 1) <> 0 And nuit(p, 1) <> 0 And jour(m, 1) = nuit(p, 1) Then
     nuit(p, 1) = ""
     jour(m, 1) = ""
     tabres(UBound(tabres)) = tab_nom(n) + m
     ReDim Preserve tabres(UBound(tabres) + 1)
     tabres(UBound(tabres)) = tab_nom(n) + p
     ReDim Preserve tabres(UBound(tabres) + 1)
   End If
  Next
 Next
Next
For n = LBound(tabres) To UBound(tabres) - 1
  If zone Is Nothing Then
    Set zone = Rows(tabres(n))
  Else
    Set zone = Application.Union(zone, Rows(tabres(n)))
  End If
Next
zone.Delete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub