Macro Création tableau avec liste itérative imbriquée

[CoOol]

Bonjour tout le monde,

La lecture du forum m'a aidé plein de fois, mais malheureusement je n'ai pas pu trouver une situation identique à la mienne. En tous cas, j'ai pas su trouver les mots juste pour la décrire.
Je souhaite créer une macro construisant un tableau (Voir en-dessous), et je ne sais pas comment faire pour m'y prendre là

Voila ce que je souhaite faire:
J'ai plusieurs champs

Champ 1 champs 2
A S
B M
C XL
D

et à partir de la je souhaite créer un tableau de cette façon
A S
A M
A XL
B S
B M
B XL
C S
C M
C XL
D S
D M
D XL

Ci joint, vous trouverez mon fichier excel (il a été grandement simplifié) avec un peu plus de détails

 

[Staple1600]

Re : Macro Création tableau avec liste itérative imbriquée

Bonsoir à tous

CoOol [Bienvenue sur le forum)
Une question
Selon ton exemple, le champ2 est vide pour D
alors pourquoi doit-on trouver comme résultat ?
D S
D M
D XL

PS: Même interrogation avec ton fichier pour D et E (car les cellules adjacentes sont vides)

 

[CoOol]

Re : Macro Création tableau avec liste itérative imbriquée

Salut Staple1600

ce qu'il faut comprendre c'est qu'il n'y a aucune liaison directe entre les champs 1 et 2

On peut imaginer les choses autrement:
Champs 1
A
B
C
D

Champs 2
S
M
L

Le but, je souhaite afficher les ventes du produit A en taille S, M et XL puis le produit B en S, M et XL ainsi de suite
J'espère que c'est un peu plus clair. N'hésites à me poser d'autres question. merci pour ton aide.

 

[Staple1600]

Re : Macro Création tableau avec liste itérative imbriquée

Re


Vois ce que tu tirer de cette macro exemple
(A TESTER SUR UN CLASSEUR VIERGE)

Sub a()
Dim dl1&, x$, sh As Worksheet: Set sh = ActiveSheet
'/////////////////////////////////////////////////////////////////////////////////////
'les trois lignes ci dessous ne servent qu'à créer les données pour l'exemple
Cells.Clear
Range("A1:A5").Value = Application.Transpose(Array("A", "B", "C", "D", "E"))
MsgBox "Poursuivre le test ?"
'////////////////////////////////////////////////////////////////////////////////////
For dl1 = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
If Cells(dl1, "A") <> Cells(dl1 - 1, "A") Then Rows(dl1).Resize(2).EntireRow.Insert
Next dl1

With Range(sh.Cells(1, 1), sh.Cells(Rows.Count, 1).End(3)(3))
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
    With .Offset(, 1)
        x = .Address
        With .Cells(1, 1).Resize(3)
        .Value = Application.Transpose([{"S","M","XL"}])
        .AutoFill Destination:=Range(x)
        End With
    End With
End With
End Sub

Je me rapproche du but recherché ?

 

[BOISGONTIER]

Re : Macro Création tableau avec liste itérative imbriquée

Bonsoir,

Essai

Sub essai()
  a = Array("s", "m", "xl")
  b = Array("a", "b", "c", "d", "e")
  c = Array("mk", "ml")
  d = Array("bv", "bc", "bn")
  Dim Tbl(0 To 200, 0 To 3)
  For m = LBound(d) To UBound(d)
   For k = LBound(c) To UBound(c)
    For j = LBound(b) To UBound(b)
     For i = LBound(a) To UBound(a)
       ind = m * (UBound(c) + 1) * (UBound(b) + 1) * (UBound(a) + 1) _
           + (k * (UBound(b) + 1) * (UBound(a) + 1)) _
             + (j * (UBound(a) + 1)) + i
       Tbl(ind, 0) = d(m)
       Tbl(ind, 1) = c(k)
       Tbl(ind, 2) = b(j)
       Tbl(ind, 3) = a(i)
     Next i
    Next j
   Next k
  Next m
  [J3:m200] = Tbl
End Sub

JB

 

[CoOol]

Re : Macro Création tableau avec liste itérative imbriquée

BOISGONTIER & Staple1600 merci pour vos contributions.

Les deux codes fonctionnent et vont dans le bon sens.
J'ai qqs question

1-comment fais-t-on pour rendre la largeur des champs est variable?
je m'explique :
Au lieu d'avoir: S M XL je peux avoir par exemple S M L XL XXL

2-si je souhaite afficher le code dans la feuille 2, comment je fais?

3-j'aimerai bien avoir une explication du code (même sommaire)

En tout cas très content du résultat, j'ai passé la journée dessus à m'arracher les cheveux.

 

[Staple1600]

Re : Macro Création tableau avec liste itérative imbriquée

Re

3-j'aimerai bien avoir une explication du code (même sommaire)

Voici pour ma part, quelques explications

Sub ab()
Dim dl1&, x$, sh As Worksheet: Set sh = ActiveSheet
'/////////////////////////////////////////////////////////////////////////////////////
'les trois lignes ci dessous ne servent qu'à créer les données pour l'exemple
Cells.Clear
Range("A1:A5").Value = Application.Transpose(Array("A", "B", "C", "D", "E"))
MsgBox "Poursuivre le test ?"
'////////////////////////////////////////////////////////////////////////////////////
'On insére une ligne vide entre dès que la valeur change dans la colonne A
For dl1 = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
If Cells(dl1, "A") <> Cells(dl1 - 1, "A") Then Rows(dl1).Resize(2).EntireRow.Insert
Next dl1

With Range(sh.Cells(1, 1), sh.Cells(Rows.Count, 1).End(3)(3))
' On insère une formule dans les cellules vides de la colonne
'formule qui recopie la valeur du dessus
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
'On transforme les formules en valeurs seuls
    .Value = .Value
'On se décale en colonne B
    With .Offset(, 1) ' dans la cellule B1
        x = .Address 'on mémorise l'adresse de la plage de cellules pour la recopie
        With .Cells(1, 1).Resize(3) 'en B1:B3 en copie S,M,XL
        .Value = Application.Transpose([{"S","M","XL"}])
'puis on recopie vers le bas ces trois valeurs
        .AutoFill Destination:=Range(x)
        End With
    End With
End With
End Sub

 

[BOISGONTIER]

Re : Macro Création tableau avec liste itérative imbriquée

Voir PJ

Les noms de champ (packageCode,pro,div,pl) sont dynamiques.

PackageCode: =DECALER(DropDownList!$H$4;;;NBVAL(DropDownList!$H:$H)-1)

Sub essai()
  a = Application.Transpose([packagecode])
  b = Application.Transpose([pro])
  c = Application.Transpose([div])
  d = Application.Transpose([pl])
  Dim Tbl(0 To 500, 0 To 3)
  ind = 0
  For m = LBound(d) To UBound(d)
   For k = LBound(c) To UBound(c)
    For j = LBound(b) To UBound(b)
     For i = LBound(a) To UBound(a)
       Tbl(ind, 0) = d(m): Tbl(ind, 1) = c(k): Tbl(ind, 2) = b(j): Tbl(ind, 3) = a(i)
       ind = ind + 1
     Next i
    Next j
   Next k
  Next m
  Sheets("tableau").[d3:g500] = Tbl
End Sub

http://boisgontierjacques.free.fr/fichiers/Cellules/Combinaison.xls

JB

 

[CoOol]

Re : Macro Création tableau avec liste itérative imbriquée

Bonjour BOISGONTIER,

Merci pour ton aide.
J'ai appliqué ton code à mon fichier de base, malheureusement, j'ai des soucis de compilation. Peux-tu jeter un coup d’œil et me dire ce qui ne vas pas.

Encore merci

Cordialement

 

[BOISGONTIER]

Re : Macro Création tableau avec liste itérative imbriquée

Bonjour,

Voir PJ

On obtient 176.000 lignes

AN =DECALER(DropDownList!$B$3;;;NBVAL(DropDownList!$B:$B)-1)
DC =DECALER(DropDownList!$D$3;;;NBVAL(DropDownList!$D:$D)-1)
Division =DECALER(DropDownList!$F$3;;;NBVAL(DropDownList!$F:$F)-1)
PackageCode =DECALER(DropDownList!$H$3;;;NBVAL(DropDownList!$H:$H)-1)
Plant =DECALER(DropDownList!$E$3;;;NBVAL(DropDownList!$E:$E)-1)
pro =DECALER(DropDownList!$G$3;;;NBVAL(DropDownList!$G:$G)-1)
Process =DECALER(DropDownList!$G$3;;;NBVAL(DropDownList!$G:$G)-1)
State =DECALER(DropDownList!$C$3;;;NBVAL(DropDownList!$C:$C)-1)

Sub essai()
  a = Application.Transpose([packagecode])
  b = Application.Transpose([Process])
  c = Application.Transpose([Division])
  d = Application.Transpose([Plant])
  e = Application.Transpose([DC])
  f = Application.Transpose([State])
  g = Application.Transpose([AN])
  Dim Tbl(0 To 300000, 0 To 6)
  ind = 0
  For o = LBound(g) To UBound(g)
   For n = LBound(f) To UBound(f)
    For m = LBound(e) To UBound(e)
     For l = LBound(d) To UBound(d)
      For k = LBound(c) To UBound(c)
       For j = LBound(b) To UBound(b)
        For i = LBound(a) To UBound(a)
         Tbl(ind, 0) = g(o): Tbl(ind, 1) = f(n): Tbl(ind, 2) = e(m): Tbl(ind, 3) = d(l): Tbl(ind, 4) = c(k): Tbl(ind, 5) = b(j): Tbl(ind, 6) = a(i)
         ind = ind + 1
        Next i
       Next j
      Next k
     Next l
    Next m
   Next n
  Next o
  Sheets("Tableau").[B3:H300000] = Tbl
End Sub

JB

 

[CoOol]

Re : Macro Création tableau avec liste itérative imbriquée

Ok tout fonctionne correctement
Un grand merci à toi BOISGONTIER. tu gères vraiment

Merci à Staple1600 aussi