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