Sub Rapprochement()
Dim Nb As Long, i As Long, j As Long, k As Long
Dim Tb
Application.ScreenUpdating = False
With Feuil1
Nb = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
If Nb > 0 Then
Tb = .Range("A3").Resize(Nb, 8).Value
For i = 1 To Nb - 1
If Tb(i, 8) = Empty And Abs(Tb(i, 6)) > 0 Then
For j = i + 1 To Nb
If Tb(j, 8) = Empty And Abs(Tb(j, 7)) > 0 Then
If Abs(Abs(Tb(i, 6)) - Abs(Tb(j, 7))) < 0.0000000001 Then
k = k + 1
Tb(i, 8) = k
Tb(j, 8) = k
Exit For
End If
End If
Next j
End If
Next i
.Range("A3").Resize(Nb, 8).Value = Tb
.Range("A3").Resize(Nb, 8).Sort Key1:=.Range("H3"), Order1:=xlAscending, Header:=xlNo
End If
End With
End Sub