VBA liste issue d'une combinaison

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