Sub Combinaisons()
Dim t#, nmax%, exclu1, exclu2, rc&, tablo$(), m%, n%, o%, p%, q%, lig&, col%
t = [NOW()]
nmax = 82 'modifiable
exclu1 = [D1].CurrentRegion.Resize(, 2) 'couples
exclu2 = [L1].CurrentRegion.Resize(, 3) 'triples
rc = Rows.Count
ReDim tablo(1 To rc, 0 To 0)
Set dicoexclu1 = CreateObject("Scripting.Dictionary")
Set dicoexclu2 = CreateObject("Scripting.Dictionary")
For m = 1 To UBound(exclu1): dicoexclu1(exclu1(m, 1) & " " & exclu1(m, 2)) = "": Next
For m = 1 To UBound(exclu2): dicoexclu2(exclu2(m, 1) & " " & exclu2(m, 2) & " " & exclu2(m, 3)) = "": Next
[P1].CurrentRegion.ClearContents 'RAZ
For m = 1 To nmax - 4
For n = m + 1 To nmax - 3
If CoupleExclu(n, m) Then GoTo 1
For o = n + 1 To nmax - 2
If CoupleExclu(o, m, n) Or TripleExclu(o, m, n) Then GoTo 2
For p = o + 1 To nmax - 1
If CoupleExclu(p, m, n, o) Or TripleExclu(p, m, n, o) Then GoTo 3
For q = p + 1 To nmax
If CoupleExclu(q, m, n, o, p) Or TripleExclu(q, m, n, o, p) Then GoTo 4
lig = lig + 1
tablo(lig, 0) = m & " " & n & " " & o & " " & p & " " & q
If lig = rc Then [P1].Offset(, col).Resize(lig) = tablo: Application.ScreenUpdating = True: DoEvents: _
ReDim tablo(1 To rc, 0 To 0): [P1].Offset(, col).Select: Columns("P").Offset(, col).AutoFit: _
lig = 0: col = col + 1: Application.StatusBar = "Colonne " & col & Format([NOW()] - t, " - hh:mm:ss")
4 Next q
3 Next p
2 Next o
1 Next n
Next m
If lig Then [P1].Offset(, col).Resize(lig) = tablo
Columns("P").Offset(, col).AutoFit
MsgBox col + 1 & " colonne(s) - " & Format(86400 * ([NOW()] - t), "0.00 \s")
End Sub