Sub Rapprochement()
Dim durée#, nlig%, nit&, P As Range, debit, credit, lettrage
Dim i&, it&, ub%, a() As Byte, s#, j%, n&
durée = Timer
Randomize
nlig = 18 'nombres de lignes précédentes étudiées, paramétrable
nit = 100000 'nombre maximum d'itérations, paramétrable
Set P = ActiveSheet.UsedRange
P.Sort ActiveSheet.[A1], xlAscending, Header:=xlYes 'tri par dates
debit = P.Columns("E") 'matrice, plus rapide
credit = P.Columns("F")
P.Columns("H").Offset(1) = "" 'RAZ
lettrage = P.Columns("H")
For i = 2 To P.Rows.Count
If credit(i, 1) > 0 Then
it = 0
ub = IIf(i > nlig + 1, nlig, i - 2)
1 ReDim a(1 To ub) 'RAZ
s = 0
For j = 1 To ub
If lettrage(i - j, 1) = "" Then
If Rnd > 0.5 Then
a(j) = 1
s = s + debit(i - j, 1)
If s > credit(i, 1) Then Exit For
End If
End If
Next
If s = credit(i, 1) Then
n = n + 1
lettrage(i, 1) = 1
P(i, "H") = n
For j = 1 To ub
If a(j) Then
lettrage(i - j, 1) = 1
P(i - j, "H") = n
End If
Next
GoTo 2
End If
If it = nit Then
lettrage(i, 1) = 1
P(i, "H") = "Pas trouvé"
GoTo 2
End If
it = it + 1
GoTo 1
End If
2 Next
MsgBox "Durée " & Format(Timer - durée, "0.0 \s")
End Sub