Sub Rapprochement()
'permet de rapprocher jusqu'à 5 débits
Dim durée#, P As Range, rc&, debit, credit, lettrage
Dim i&, j&, cred As Single, a&, n&, b&, c&, d&, e&, f&
durée = Timer
Set P = ActiveSheet.ListObjects(1).DataBodyRange
rc = P.Rows.Count
P.Sort [D1], xlDescending, Header:=xlYes 'tri par dates
debit = P.Columns("I") 'matrice, plus rapide
credit = P.Columns("J")
P.Columns("K").ClearContents 'RAZ
Range("N2,N4").ClearContents
Range("N3") = "=COUNT(K:K)"
lettrage = P.Columns("K")
For i = 1 To rc
Range("N2") = i & "/" & rc 'comptage
If credit(i, 1) > 0 Then
j = IIf(i > 50, i - 50, 1) 'LES 50 DERNIERS DEBITS SONT TRAITES
cred = credit(i, 1)
'---1 débit---
For a = j To i - 1
If lettrage(a, 1) = 1 Then GoTo 2
If CSng(debit(a, 1)) <> cred Then GoTo 2
n = n + 1
lettrage(i, 1) = 1
lettrage(a, 1) = 1
P(i, "K") = n
P(a, "K") = n
GoTo 1
2 Next a
'---2 débits---
For a = j To i - 2
If lettrage(a, 1) = 1 Then GoTo 3
For b = a + 1 To i - 1
If lettrage(b, 1) = 1 Then GoTo 4
If CSng(debit(a, 1) + debit(b, 1)) <> cred Then GoTo 4
n = n + 1
lettrage(i, 1) = 1
lettrage(a, 1) = 1
lettrage(b, 1) = 1
P(i, "K") = n
P(a, "K") = n
P(b, "K") = n
GoTo 1
4 Next b
3 Next a
'---3 débits---
For a = j To i - 3
If lettrage(a, 1) = 1 Then GoTo 5
For b = a + 1 To i - 2
If lettrage(b, 1) = 1 Then GoTo 6
For c = b + 1 To i - 1
If lettrage(c, 1) = 1 Then GoTo 7
If CSng(debit(a, 1) + debit(b, 1) + _
debit(c, 1)) <> cred Then GoTo 7
n = n + 1
lettrage(i, 1) = 1
lettrage(a, 1) = 1
lettrage(b, 1) = 1
lettrage(c, 1) = 1
P(i, "K") = n
P(a, "K") = n
P(b, "K") = n
P(c, "K") = n
GoTo 1
7 Next c
6 Next b
5 Next a
'---4 débits---
For a = j To i - 4
If lettrage(a, 1) = 1 Then GoTo 8
For b = a + 1 To i - 3
If lettrage(b, 1) = 1 Then GoTo 9
For c = b + 1 To i - 2
If lettrage(c, 1) = 1 Then GoTo 10
For d = c + 1 To i - 1
If lettrage(d, 1) = 1 Then GoTo 11
If CSng(debit(a, 1) + debit(b, 1) + _
debit(c, 1) + debit(d, 1)) <> cred Then GoTo 11
n = n + 1
lettrage(i, 1) = 1
lettrage(a, 1) = 1
lettrage(b, 1) = 1
lettrage(c, 1) = 1
lettrage(d, 1) = 1
P(i, "K") = n
P(a, "K") = n
P(b, "K") = n
P(c, "K") = n
P(d, "K") = n
GoTo 1
11 Next d
10 Next c
9 Next b
8 Next a
'---5 débits---
For a = j To i - 5
If lettrage(a, 1) = 1 Then GoTo 12
For b = a + 1 To i - 4
If lettrage(b, 1) = 1 Then GoTo 13
For c = b + 1 To i - 3
If lettrage(c, 1) = 1 Then GoTo 14
For d = c + 1 To i - 2
If lettrage(d, 1) = 1 Then GoTo 15
For e = d + 1 To i - 1
If lettrage(e, 1) = 1 Then GoTo 16
If CSng(debit(a, 1) + debit(b, 1) + _
debit(c, 1) + debit(d, 1) + _
debit(e, 1)) <> cred Then GoTo 16
n = n + 1
lettrage(i, 1) = 1
lettrage(a, 1) = 1
lettrage(b, 1) = 1
lettrage(c, 1) = 1
lettrage(d, 1) = 1
lettrage(e, 1) = 1
P(i, "K") = n
P(a, "K") = n
P(b, "K") = n
P(c, "K") = n
P(d, "K") = n
P(e, "K") = n
GoTo 1
16 Next e
15 Next d
14 Next c
13 Next b
12 Next a
lettrage(i, 1) = 1
P(i, "K") = "Pas trouvé"
Range("N4") = Range("N4") + 1 'comptage
DoEvents 'pour l'affichage
End If
1 Next i
MsgBox "Durée " & Format(Timer - durée, "0.0 \s")
End Sub