Générer tous les arrangements possibles

ladoudette

XLDnaute Nouveau
Bonjour à tous,

Ce forum est très intéressant et on y trouve de nombreuses astuces et aides en tout genre. Oui mais voilà, j'ai eu beau chercher et chercher, je n'ai pas réussi à trouver de solution à mon problème, peut-être tout simplement car je ne suis pas très douée... :(

Je dois générer tous les arrangements possibles (on est d'accord, dans les arrangements, on tient compte de l'ordre, NR est différent de RN par exemple) pour 6 lettres différentes parmi lesquelles on en choisit soit 2, soit 3, soit 4, soit 5.
Je cherche donc à générer automatiquement les arrangements possibles pour chaque quantité de lettres choisies.

J'ai essayé des solutions trouvées sur le forum mais malheureusement, soit Excell buggait (peut-être que ce n'était pas la bonne version) ou bien la solution proposée était trop éloignée de ce que je cherche et je ne réussissais pas à modifier la macro en conséquence...

Quelqu'un aurait-il une solution à me proposer ??:confused:

Merci beaucoup à ceux qui liront mon message et tenteront de trouver quelque chose à me proposer.
 

ladoudette

XLDnaute Nouveau
Re : Générer tous les arrangements possibles

Merci pour votre réponse si rapide JJ1.

En fait, ce n'est pas tout à fait ça que je recherche.
Premièrement, et c'est vrai que j'aurais du le préciser, il ne doit pas y avoir de répétition : chaque lettre ne peut apparaître qu'une seule fois dans l'arrangement.
Deuxièmement, je dois pouvoir générer les arrangements pour chaque quantité. C'est à dire tous les arrangements possibles pour 2 lettres, puis tous les arrangements possibles pour 3 lettres, 4 lettres et enfin 5 lettres parmi les 6 lettres possibles qui sont N, R, J, B, V, et W (pour noir, rose, jaune, bleu, vert et white).
Ensuite, mais ça, je ne sais vraiment pas si c'est possible, il faudrait que mes arrangements apparaissent chacun dans une cellule. Par exemple, NR dans une cellule pour cet arrangement, et non N dans une cellule et R dans une autre cellule pour l'arrangement NR. Je ne sais pas si je suis claire...

Une autre suggestion peut-être ??

Merci en tous les cas à ceux qui se pencheront sur mon problème...

Ladoudette
 

KenDev

XLDnaute Impliqué
Re : Générer tous les arrangements possibles

Bonsoir à tous,

Une possibilité avec le code ci-dessous. Les permutations s'écrivent en colonne A d'une nouvelle feuille. Cordialement

KD

VB:
Sub Arrangement()
    Dim i&, L As Byte, j&, Tb() As Byte, t$, k As Byte, ii As Byte, b As Boolean, Ts() As Byte, n&, Tl$()
    Const St = "NRJBVW"
    L = Len(St): ReDim Ts(1 To L, 0)
    For i = 2 To L - 1 'To L pour inclure les permuts avec tous les éléments / For i=1 pour inclure les éléments seuls
        ReDim Tb(1 To i)
        For j = 10 ^ (i - 1) To 10 ^ i - 1
            t = j
            For k = 1 To i
                Tb(k) = Right(Left(t, k), 1)
                If Tb(k) > L Or Tb(k) = 0 Then b = False: Exit For
                b = True
                For ii = 1 To k - 1
                    If Tb(k) = Tb(ii) Then b = False: Exit For
                Next ii
                If Not b Then Exit For
            Next k
            If b Then
                n = n + 1
                ReDim Preserve Ts(1 To L, n)
                For k = 1 To i: Ts(k, n) = Tb(k): Next k
            End If
        Next j
    Next i
    Sheets.Add
    ReDim Tl(1 To L)
    For i = 1 To L: Tl(i) = Right(Left(St, i), 1): Next i
    For i = 1 To UBound(Ts, 2)
        t = ""
        For j = 1 To L
            If Ts(j, i) > 0 Then t = t & Tl(Ts(j, i)) Else Exit For
        Next j
        Cells(i, 1) = t
    Next i
End Sub
 
Dernière édition:

ladoudette

XLDnaute Nouveau
Re : Générer tous les arrangements possibles

Euh... alors moi qui ne comprend rien à la manière dont s'écrive les macros, j'ai ouvert VBA et puis Code. J'ai collé ce que Kendev a proposé, puis j'ai écrit les 6 lettres dans la première ligne de la première feuille et j'ai lancé la macro... et là... MIRACLE !!! C'est tout à fait ce que je voulais faire.

Je serais tout à fait incapable de transposer ça à autre chose, mais pour ce que j'ai à faire, j'ai gagné des heures, évité des erreurs inévitables, et préserver mon tube d'ibuprofène !

Alors un très grand MERCI à KenDev et un très grand MERCI aux créateurs de ce forum.

Ladoudette.
 

Guelor

XLDnaute Nouveau
Re : Générer tous les arrangements possibles

Bonsoir à tous,

Une possibilité avec le code ci-dessous. Les permutations s'écrivent en colonne A d'une nouvelle feuille. Cordialement

KD

VB:
Sub Arrangement()
    Dim i&, L As Byte, j&, Tb() As Byte, t$, k As Byte, ii As Byte, b As Boolean, Ts() As Byte, n&, Tl$()
    Const St = "NRJBVW"
    L = Len(St): ReDim Ts(1 To L, 0)
    For i = 2 To L - 1 'To L pour inclure les permuts avec tous les éléments / For i=1 pour inclure les éléments seuls
        ReDim Tb(1 To i)
        For j = 10 ^ (i - 1) To 10 ^ i - 1
            t = j
            For k = 1 To i
                Tb(k) = Right(Left(t, k), 1)
                If Tb(k) > L Or Tb(k) = 0 Then b = False: Exit For
                b = True
                For ii = 1 To k - 1
                    If Tb(k) = Tb(ii) Then b = False: Exit For
                Next ii
                If Not b Then Exit For
            Next k
            If b Then
                n = n + 1
                ReDim Preserve Ts(1 To L, n)
                For k = 1 To i: Ts(k, n) = Tb(k): Next k
            End If
        Next j
    Next i
    Sheets.Add
    ReDim Tl(1 To L)
    For i = 1 To L: Tl(i) = Right(Left(St, i), 1): Next i
    For i = 1 To UBound(Ts, 2)
        t = ""
        For j = 1 To L
            If Ts(j, i) > 0 Then t = t & Tl(Ts(j, i)) Else Exit For
        Next j
        Cells(i, 1) = t
    Next i
End Sub
Bonjour,
Je trouve ce forum très intéressant.
Sinon j'ai aussi une préoccupation. Comment peut-t-on générer les différents arrangements de 10 matchs de basket-ball, sachant sachant que le résultat d'un match est soit 1 (gagné) ou soit 2 (perdre).
Merci de vouloir m'aider.
 

Discussions similaires

Réponses
8
Affichages
489

Statistiques des forums

Discussions
312 215
Messages
2 086 330
Membres
103 188
dernier inscrit
evebar