XL 2013 Générer des combinaisons

[lmontagne31]

Bonjour à tous,

j'ai un tableau qui est du style

et j'aimerai générer une liste de toutes les combinaison sachant que je ne peux avoir qu'une case renseignée par ligne.

...

2 jour que je cherche l'algorithme mais impossible.
Pouvez vous m'aider SVP.
Merci

 

[dysorthographie]

Bonjour,
Tu fais des tablatures pour tes amis guitaristes ?

 

[Softmama]

Bonjour lmontagne31, dysorthographie,

Une réponse dans le fichier joint.
Pour moi, si j'ai bien compris la problématique, il y a 625 - 1 combinaisons : 5 par ligne sur 4 lignes, soient 5*5*5*5 - 1 car le code 0000 (aucune croix est à éliminer) :

Sub test()
Dim Table(), n As Integer
ReDim Table(1 To 1, 1 To 1)
 For t = 0 To 4 'Activities1 : 0 pas de croix, 1= Croix en S, 2=Croix en M, 3= croix en V, 4=Croix en VC
   For u = 0 To 4 'Activities2... pareil
     For v = 0 To 4 'Activities3... pareil
       For w = 0 To 4 'Activities4... pareil
         n = n + 1
         ReDim Preserve Table(1 To 1, 1 To n)
         Table(1, n) = "'" & t & u & v & w 'Code
       Next
     Next
   Next
 Next
 Feuil1.Range("A10").Resize(UBound(Table, 2), 1) = Application.Transpose(Table) 'Liste de toutes les combinaisons
End Sub

Le détail dans le fichier.

 

[Softmama]

re bonjour le fil,

Pour répondre plus précisément à votre demande, je fais afficher dans cette version mise à jour, les 625 combinaisons, non plus sous la forme d'un code, mais avec les croix dans les cases, comme demandé :

Sub test()
Dim c As Range

Application.ScreeUpdating = False
For t = 0 To 4
  For u = 0 To 4
    For v = 0 To 4
      For w = 0 To 4
        If t+u+v+w <> 0 Then 'Pour éviter aucune croix
          Set c = Feuil2.Range("A1000000").End(xlUp).Offset(2)
          Feuil2.Range("A2:F6").Copy c
          c.Offset(1, 5) = t
          c.Offset(2, 5) = u
          c.Offset(3, 5) = v
          c.Offset(4, 5) = w
        End If
      Next
    Next
  Next
Next
Application.ScreeUpdating = True

End Sub

Attention, l'ensemble des 625 tableaux occupe 3500 lignes environ.
cf. fichier joint

 

[lmontagne31]

re bonjour le fil,

Pour répondre plus précisément à votre demande, je fais afficher dans cette version mise à jour, les 625 combinaisons, non plus sous la forme d'un code, mais avec les croix dans les cases, comme demandé :

Sub test()
Dim c As Range

Application.ScreeUpdating = False
For t = 0 To 4
  For u = 0 To 4
    For v = 0 To 4
      For w = 0 To 4
        If t+u+v+w <> 0 Then 'Pour éviter aucune croix
          Set c = Feuil2.Range("A1000000").End(xlUp).Offset(2)
          Feuil2.Range("A2:F6").Copy c
          c.Offset(1, 5) = t
          c.Offset(2, 5) = u
          c.Offset(3, 5) = v
          c.Offset(4, 5) = w
        End If
      Next
    Next
  Next
Next
Application.ScreeUpdating = True

End Sub

Attention, l'ensemble des 625 tableaux occupe 3500 lignes environ.
cf. fichier joint

Merci beaucoup c'est exactement ce dont j'avais besoin.