Permutation d'elements

Bonsoir

j'ai realisé le bout de code suivant permettant de calculer toutes les permutations possibles de caracteres présentés dans un tableau de type array que voici :

Option Base 1
Sub permutations()
t = Array("A", "B", "C", "D", "E", "F")   ' c'est la chaine choisie mais on peut ajouter des caracteres
For c = 1 To UBound(t)
 debut = debut & c
 fin = fin & UBound(t) - x
 x = x + 1
Next

For i = Val(debut) To Val(fin)
n = 0

  For k = 1 To Len(i)
   If InStr(i, k) > 0 Then
     n = n + 1
   End If
  Next
  If n = Len(i) Then

      ch = ""
       For j = 1 To Len(i)
        ch = ch & t(Val(Mid(i, j, 1)))
       Next
          Cells(65000, 1).End(xlUp).Offset(1, 0) = ch  ' renvoi les resultats dans la colonne 1 de ma feuille de calcul 
   End If

Next
End Sub

Le code tourne mais est il suffisamment bien présenté ? Merci .

Salut rocket4,

AStucieux!

La présentation est affaire personnelle : il est des codes efficaces que je ne comprends qu'après les avoir moulinés à ma sauce!

Sauce Curulis : celle que je préfère!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
t = Array("A", "B", "C", "D", "E", "F")   ' c'est la chaine choisie mais on peut ajouter des caracteres
'
For c = 1 To UBound(t)
    debut = debut & c
    fin = fin & UBound(t) - (c - 1)
Next
For i = Val(debut) To Val(fin)
    n = 0
    For k = 1 To Len(i)
        If InStr(i, k) > 0 Then n = n + 1
    Next
    If n = Len(i) Then
        ch = ""
        For j = 1 To Len(i)
            ch = ch & t(Val(Mid(i, j, 1)))
        Next
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = ch  ' renvoi les resultats dans la colonne 1 de ma feuille de calcul
    End If
Next
'
End Sub

A+

Bonjour,

Avec une fonction récursive :

Sub Test()

    Dim Tbl()
    Dim T
    Dim I As Integer
    Dim J As Long
    Dim Chaine As String

    T = Array("A", "B", "C", "D", "E", "F")

    For I = 0 To UBound(T): Chaine = Chaine & T(I): Next I

    Permuter Chaine, "", Tbl, J
    Columns(1).Clear
    Range(Cells(1, 1), Cells(UBound(Tbl), 1)).Value = Application.Transpose(Tbl)

End Sub

Sub Permuter(Chaine As String, Debut As String, Tbl(), J As Long)

    Dim I As Integer

    If Len(Chaine) = 1 Then

         J = J + 1: ReDim Preserve Tbl(1 To J)
        Tbl(J) = Debut & Chaine

    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 à tous pour vos suggestions ! il y a effectivement plusieurs facons de faire

Il y a toujours plusieurs façons de faire, j'en ai montré une mais il faut savoir qu'une fonction récursive est consommatrice de mémoire car il faut stocker les résultats intermédiaires à chaque appel de la fonction. Une fonction récursive très connue, la factorielle d'un nombre, ici un petit exemple du fonctionnement, il te faut ouvrir la fenêtre d'exécution (Ctrl+G) et exécuter la sub "Test(')" avec F8 (en pas à pas) :

Sub test()

    MsgBox Factorielle(10)

End Sub

Function Factorielle(Nb As Integer)

    'déclarées en static pour garder en mémoire les valeurs
    Static Rappel As Integer
    Static Fin As Boolean

    Rappel = Rappel + 1: Debug.Print Rappel

    If Nb = 1 Then 'Point de sortie, absolument obligatoire pour éviter une boucle sans fin !

        Factorielle = 1
        Fin = True
        Debug.Print "Maintenant, phase de calcul !"

    Else

        'à chaque appel, le résultat est stoké en mémoire
        'ce qui crée unne pile des appels
        Factorielle = Nb * Factorielle(Nb - 1)

    End If

    'on remonte la pile des appels
    If Fin = True Then Rappel = Rappel - 1: Debug.Print Rappel

End Function