Sub Rapprochement()
'permet de rapprocher jusqu'à 5 débits
Dim durée#, P As Range, debit, credit, lettrage
Dim i&, cred As Single, a&, n&, b&, c&, d&, e&, f&
durée = Timer
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
cred = credit(i, 1)
'---1 débit---
For a = 2 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, "H") = n
P(a, "H") = n
GoTo 1
2 Next a
'---2 débits---
For a = 2 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, "H") = n
P(a, "H") = n
P(b, "H") = n
GoTo 1
4 Next b
3 Next a
'---3 débits---
For a = 2 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, "H") = n
P(a, "H") = n
P(b, "H") = n
P(c, "H") = n
GoTo 1
7 Next c
6 Next b
5 Next a
'---4 débits---
For a = 2 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, "H") = n
P(a, "H") = n
P(b, "H") = n
P(c, "H") = n
P(d, "H") = n
GoTo 1
11 Next d
10 Next c
9 Next b
8 Next a
'---5 débits---
For a = 2 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, "H") = n
P(a, "H") = n
P(b, "H") = n
P(c, "H") = n
P(d, "H") = n
P(e, "H") = n
GoTo 1
16 Next e
15 Next d
14 Next c
13 Next b
12 Next a
lettrage(i, 1) = 1
P(i, "H") = "Pas trouvé"
DoEvents 'pour l'affichage
End If
1 Next i
MsgBox "Durée " & Format(Timer - durée, "0.0 \s")
End Sub