Sub RunAffichCombin()
Call AffichCombin("A47UI&m1_r")
End Sub
Private Sub AffichCombin(ByVal Mot$)
Dim Rw&, Co&, Ln&, Lm&, Ta$(), i&, ac&, Cp&, Cb&(), j&, Fin&
Ln = Len(Mot): ReDim Ta(1 To Ln): Lm = Rows.Count: Co = 1
For i = 1 To Ln: Ta(i) = Right(Left(Mot, i), 1): Next i
ac = Application.Calculation: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual: Sheets.Add
For i = Ln To 1 Step -1
Cp = 0: Fin = Ln - i + 1
Do
Cp = Cp + 1: Rw = Rw + 1: Cb = CmbNthTab(Ln, i, Cp)
For j = 1 To i: Cells(Rw, Co) = Cells(Rw, Co) & Ta(Cb(j)): Next j
If Rw = Lm Then Co = Co + 1: Rw = 0
Loop Until Cb(1) = Fin
Next i
Cells.EntireColumn.AutoFit: Application.Calculation = ac
End Sub
Private Function CmbNthTab(ByVal a&, ByVal b&, ByVal Nth$) As Long()
Dim Tb&(), i&, x&, d&
ReDim Tb(b)
Do
d = d + 1: x = 0
For i = a - 1 - Tb(d - 1) To b - d Step -1
x = x + CmbNb(i, b - d)
If Not Nth > x Then Exit For
Next i
Tb(d) = a - i: Nth = Nth + CmbNb(i, b - d) - x
Loop Until d = b
CmbNthTab = Tb
End Function
Private Function CmbNb(ByVal a&, ByVal b&) As Variant
Dim c&
c = a - b
If b < c Then c = b
If c = 0 Then CmbNb = 1 Else CmbNb = MthFac(a, c) / MthFac(c)
End Function
Private Function MthFac(ByVal a&, Optional Nb& = 0) As Variant
Dim i&, n&
If Nb = 0 Then Nb = a
MthFac = 1
For i = 0 To Nb - 1: MthFac = MthFac * (a - i): Next i
End Function