Liste des permutations de N objets numérotés de 1 à N

Bonsoir

Je cherche un macro qui peut lister les permutations de N nombres entiers (1,2,3.....N). Chaque permutation sur une ligne.

123

132

213

231

312

321

Quelqu'un peut-il m'aider?

Merci pour votre contribution et bonne soirée.

Gabriel

Bonjour,

Insérer le code suivant dans un module

Sub GetString()
    Dim xStr As String
    Dim FRow As Long
    Dim xScreen As Boolean
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xStr = Application.InputBox("Entrer le nombre à permuter:", "Kutools for Excel", , , , , , 2)
    If Len(xStr) < 2 Then Exit Sub
    If Len(xStr) >= 8 Then
        MsgBox "Il y a trop de permutations!", vbInformation, "Kutools for Excel"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        FRow = 1
        Call GetPermutation("", xStr, FRow)
    End If
    Application.ScreenUpdating = xScreen
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long)
    Dim i As Integer, xLen As Integer
    xLen = Len(Str2)
    If xLen < 2 Then
        Range("A" & xRow) = Str1 & Str2
        xRow = xRow + 1
    Else
        For i = 1 To xLen
            Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)
        Next
    End If
End Sub

Bonne journée

Merci Jacky

Le problème est résolu..

Bon dimanche

Gabriel

Bonjour Jacky

Merci j'ai retiré le "if =>8 then " et tout marche très bien. Maintenant j'aimerais les string comme 23415678 signe après signe et les écrire dans des cellules individuelles. Je ne suis pas chez moi et n'ai de manuel VBA à disposition. Pourrais-tu également me donner une idée.

Merci pour ton support que j'pprécie beaucoup.

Bon dimanche

Gabriel

Pour 8! c'est à dire 1*2*3*4*5*6*7*8 = 4360 si je ne m'abuse, je crains que ce soit beaucoup, mais essaie en transformant la ligne :

If Len(xStr) >= 8 Then en If Len(xStr) >= 4500 Then

par exemple, mais je pense que le résultat ne soit pas probant

Cordialement

Jacky

bonjour,

une autre proposition

Sub Testpermut()
    Dim Tbl()
    Dim i As Long, ne As Long, j As Long
    Dim Chaine As String
    Chaine = InputBox("permutation : introduire la chaine de caractères ")
    If Len(Chaine) > 9 Then
        MsgBox "trop de caractères à permuter"
        Exit Sub
    End If
    ne = Application.WorksheetFunction.Fact(Len(Chaine))
    ReDim Tbl(1 To ne, 1 To Len(Chaine))
    Permuter Chaine, "", Tbl, j
    Columns(1).Clear
    Range(Cells(1, 1), Cells(j, Len(Chaine))).Value = Tbl
End Sub

Sub Permuter(Chaine As String, Debut As String, Tbl(), j As Long)
    Dim i As Long, texte As String
    If Len(Chaine) = 1 Then
        j = j + 1
        texte = Debut & Chaine
        For i = 1 To Len(texte)
            Tbl(j, i) = Mid(texte, i, 1)
        Next i
    Else
        For i = 1 To Len(Chaine)
            Permuter Mid(Chaine, 2, Len(Chaine) - 1), Debut & Left(Chaine, 1), Tbl, j
            Chaine = Mid(Chaine, 2, Len(Chaine) - 1) & Left(Chaine, 1)
        Next
    End If
End Sub

Merci h2SO4

Solution géniale elle fait tout ce dont j'ai besoin...

Bonne soirée

Gabriel