Permutations avec répétitions

[Amrita11]

Bonjour,
J'ai crée un arbre pour 3 chiffres
Le remplissage se fait par macro mais comme je suis un débutant j'aimerais avoir conseils et critiques afin de m'en servir pour 4 chiffres
Le classeur est joint
Remerciements anticipés
Cordiales salutations

 

[ROGER2327]

Re : Permutations avec répétitions

Bonjour Amrita11

Voici une proposition de code adaptable de 0 à 6 (au-delà, les feuilles d'Excel 2003 sont trop courtes) :

[B][COLOR="DarkSlateGray"]Sub toto(base)
Dim i&, j%, n%, k%, d%, p%, ol&, oc&, oCel As Range, m%, tmp$
   n = base [COLOR="SeaGreen"]'Base de calcul de 0 à 6[/COLOR]
   d = 1 [COLOR="SeaGreen"]'Décalage des groupes de résultats[/COLOR]
   p = 2 [COLOR="SeaGreen"]'Décalage des colonnes de résultats[/COLOR]
   ol = 7 [COLOR="SeaGreen"]'Première ligne du tableau de résultats[/COLOR]
   oc = 4 [COLOR="SeaGreen"]'Première colonne du tableau de résultats[/COLOR]
   Range(Cells(ol, oc), Cells(ol, oc).SpecialCells(xlCellTypeLastCell)).ClearContents
   For k = 1 To n
      j = 0
      For i = 1 To n ^ (n - k + 1) - (k <> n) * (d * n ^ (n - k - 1)) Step n ^ (n - k) - (k <> n) * (d * n ^ (n - k - 1))
         j = j + 1
         Cells(i, p * (k - 1) + 1).Offset(ol - 1, oc - 1).Value = j
      Next i
      With Range(Cells(1, p * (k - 1) + 1), Cells(n ^ (n - k + 1), p * (k - 1) + 1)).Offset(ol - 1, oc - 1)
         For i = 0 To n ^ (k - 1) - 1
            .Offset(i * n ^ (n - k) * (n + d), 0).Value = .Value
            If k = n Then
               For Each oCel In .Offset(i * n ^ (n - k) * (n + d), 0).Cells
                  tmp = ""
                  For m = n - 1 To 0 Step -1
                     With oCel.Offset(0, -p * m)
                        If CStr(.Value) = "" Then
                           tmp = tmp & CStr(.End(xlUp).Value)
                        Else
                           tmp = tmp & CStr(.Value)
                        End If
                     End With
                  Next m
                  oCel.Offset(0, p).Value = tmp
               Next oCel
            End If
         Next i
      End With
   Next k
End Sub[/COLOR][/B]

Ce code est à placer dans un module standard. (Il est dans le module ModParam dans le classeur joint.)

Pour l'utiliser, il convient de l'appeler à partir d'un module de feuille en lui passant l'argument base (entier de 0 à 6).
Dans le classeur joint, j'ai mis des feuilles pour les valeurs 2, 3, 4 et 5 du paramètre base (les feuilles Feuil2, Feuil3, Feuil4 et Feuil5).
Le code placé dans le module de la feuille Feuil2 est :

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 2
End Sub[/B][/COLOR]

Ce code active la feuille Feuil2 et exécute la procédure toto avec 2 comme valeur du paramètre base.

Code similaire dans les modules des autres feuilles.
Pour la feuille Feuil3

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 3
End Sub[/B][/COLOR]

Pour la feuille Feuil4

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 4
End Sub[/B][/COLOR]

Pour la feuille Feuil5

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 5
End Sub[/B][/COLOR]

Pour exécuter une de ces procédures, presser les touches Alt F8 et choisir Feuil2.tata, Feuil3.tata, Feuil4.tata ou Feuil5.tata.

Si ce code vous pose des problèmes, j'essaierai de vous aider à les résoudre, mais dans deux ou trois semaines. L'heure des vacances sonne...
​

Bon courage !
ROGER2327
#3998

Samedi 21 Tatane 137 (Saints Catoblepas, lord et Anoblepas, amirals, SQ)
16 Thermidor An CCXVIII
2010-W31-2T21:12:25Z