Sub IceCombins()
Dim t(), i&, j%, a%, b%, u%(), c%, v(), d&
a = Cells(Rows.Count, 1).End(xlUp).Row
ReDim t(1 To a)
For i = 1 To a: t(i) = Cells(i, 1): Next i
Do
b = Application.InputBox(prompt:="1 - " & a & " ?", Type:=1)
If b = 0 Then Exit Sub
Loop Until b > 0 And b < a + 1
u = CombinTab(a, b): c = UBound(u, 2): d = UBound(u): ReDim v(1 To c, 1 To d)
If d > Rows.Count Then MsgBox "Le nombre de combinaisons dépasse le nombre de lignes d'une feuille.": Exit Sub
For i = 1 To d: For j = 1 To c: v(j, i) = t(u(i, j)): Next j, i
Erase t: Erase u: Sheets.Add: Range(Cells(1, 1), Cells(d, c)).Value = Application.Transpose(v)
End Sub
'----------------------------------------------------------------------------------------------------------------
'Tableau des combinaisons de b objets parmi a objets / pas de contrôles des entrées******************************
'----------------------------------------------------------------------------------------------------------------
Function CombinTab(ByVal a%, ByVal b%) As Integer()
Dim n&, t%(), c%, i&, j&, d As Boolean: n = CombinNb(a, b): ReDim t(1 To n, 1 To b): c = a - b
For i = 1 To b: t(1, i) = i: Next i
For i = 2 To n
If b = 1 Then t(i, 1) = t(i - 1, 1) + 1 Else t(i, 1) = t(i - 1, 1) - (t(i - 1, 2) = c + 2)
For j = 2 To b - 1
If Not (t(i - 1, j + 1) = c + j + 1) Then t(i, j) = t(i - 1, j) Else d = t(i - 1, j) = c + j: t(i, j) = t(i + Not d, j + d) + 1
Next j
If t(i - 1, b) = a Then t(i, b) = t(i, b - 1) + 1 Else t(i, b) = t(i - 1, b) + 1
Next i
CombinTab = t
End Function
'----------------------------------------------------------------------------------------------------------------
'Nb de combinaisons, b objets parmi a objets / pas de contrôles des entrées**************************************
'----------------------------------------------------------------------------------------------------------------
Function CombinNb(ByVal a%, ByVal b%) As Long
Dim c%: c = a - b
If b < c Then c = b
If c = 0 Then CombinNb = 1 Else CombinNb = Factorielle(a, c) / Factorielle(c)
End Function
'----------------------------------------------------------------------------------------------------------------
'Factorielle, option: limiter le nombre d'itérations / pas de contrôles des entrées******************************
'----------------------------------------------------------------------------------------------------------------
Function Factorielle(ByVal f%, Optional n%) As Double
Dim i&
If n = 0 Then n = f
Factorielle = 1
If f > 0 Then
For i = 0 To n - 1: Factorielle = Factorielle * (f - i): Next i
End If
End Function
