Sub test()
Dim t, deb
deb = Timer
Application.ScreenUpdating = False
With Sheets("Feuil1")
If .FilterMode Then .ShowAllData
.Range("a1").CurrentRegion.ClearContents
t = CombiLettres(8, 15)
.Range("a1").Resize(UBound(t), UBound(t, 2)) = t
End With
MsgBox "durée = " & Format(Timer - deb, "#,##0.00\ sec.")
End Sub
Function CombiLettres(ByVal p As Long, n As Long)
Dim tablo, i&, j&
tablo = TableauCombiPparmiN(p, n)
ReDim result(1 To UBound(tablo), 1 To n)
For i = 1 To UBound(tablo): For j = 1 To UBound(tablo, 2): result(i, tablo(i, j)) = Chr(64 + tablo(i, j)): Next j: Next i
CombiLettres = result
End Function
Function TableauCombiPparmiN(ByVal p As Long, ByVal n As Long)
Dim i&, Inc&, base&, ncombi&, nres&, k&
'initialisation
ReDim Combi&(1 To p) 'tableau de la combinaison en cours d'édition
ReDim Max&(1 To p) 'tableau des maximums autorisés pour chaque colonne
ncombi = Application.WorksheetFunction.Combin(n, p) 'nombre de combinaisons (P parmi N)
ReDim res(1 To ncombi, 1 To p) 'tableau de toutes les combinaisons
'la première combinason est (1, 2 , 3, ... , P)
For i = 1 To p: Combi(i) = i: Next
'les maximums autorisés par colonnes sont (N-P+1, N-P+2, N-P+3, ... , N-2, N-1, N)
For i = 0 To p - 1: Max(p - i) = n - i: Next
'stockage de la première combinaison
nres = nres + 1: For i = 1 To p: res(nres, i) = Combi(i): Next
'boucle pour les autres combi
Inc = p 'la colonne à incrémenter est la dernière
Do
If Combi(Inc) + 1 > Max(Inc) Then
'si l'élément de combi en colonne Inc incrémenté de 1
'dépasse le maximun autorisé, on décrémente Inc
Inc = Inc - 1
'si Inc arrive à zéro, on est à la fin de la boucle
If Inc = 0 Then Exit Do
Else
'si l'élément de combi en colonne Inc incrémenté de 1
'ne dépasse pas le maximun autorisé, on incrémente cet élément
Combi(Inc) = Combi(Inc) + 1
'les éléments suivants sont chacun égaux à la somme du précédent + 1
For i = Inc + 1 To p: Combi(i) = Combi(i - 1) + 1: Next
'on stocke la nouvelle combinaison
nres = nres + 1: For i = 1 To p: res(nres, i) = Combi(i): Next
Inc = p
End If
Loop
TableauCombiPparmiN = res
End Function