Avez vous un code pour mettre une liste en Tableau?

Version imprimable

19/02/2019, 09h29
jbesclapez

Avez vous un code pour mettre une liste en Tableau?

Bonjour a tous,

J ai une liste sur en 3 colonnes et je cherche a mettre ca en tableau 2D.
En colonne 1 j ai le nom qui ira en axe vertical du tableau
En colonne 2 j ai l attribut qui ira en axe horizontal du tableau
En colonne 3 J ai la valeur a mettre en intersection dans le tableau.

Attention: Je n ai pas toujours les memes attributs (colonne 2) pour tous les noms. Il y aura donc des champs vides dans le tableau final.

Meme si ce code a l air simple, je suis trop debutant pour le realise mais en gros voila ce que je ferais :
1- Liste la colonne 1 et la copie en colonne 2 du tableau en valeur unique - En A2
2- Liste la colonne 2 et la copie en transposant avec valeurs unique dans le tableau - En B1
3- Pour chaque valeur en colonne 3, lis la colonne 1 et 2 et va chercher le croisement dans le tableau 2d - Ca ca a l air hyper complique a faire...

Merci de votre aide.
19/02/2019, 09h35
halaster08

Bonjour

Si tes valeurs en colonne 3 sont numériques, un TCD te donnera le résultat en quelques seconde.
19/02/2019, 09h47
jbesclapez

Citation:

Envoyé par halaster08

Bonjour

Si tes valeurs en colonne 3 sont numériques, un TCD te donnera le résultat en quelques seconde.

Les valeurs sont du texte et je ne veux pas de TCD. Je sais... ca complique :-)
19/02/2019, 10h05
halaster08

Citation:

Meme si ce code a l air simple, je suis trop debutant pour le realise mais en gros voila ce que je ferais :
1- Liste la colonne 1 et la copie en colonne 2 du tableau en valeur unique - En A2
2- Liste la colonne 2 et la copie en transposant avec valeurs unique dans le tableau - En B1
3- Pour chaque valeur en colonne 3, lis la colonne 1 et 2 et va chercher le croisement dans le tableau 2d - Ca ca a l air hyper complique a faire...

Pour les points 1 et 2, utilise l'enregistreur de macro
Pour le 3:c'est très simple a faire en Excel avec une combinaison des formules INDEX et EQUIV, une fois la formule correcte trouvée, il suffit de la traduire en vba (si besoin l'enregistreur de maccro peut là encore t'aider)

Citation:

Envoyé par halaster08

Pour les points 1 et 2, utilise l'enregistreur de macro
Pour le 3:c'est très simple a faire en Excel avec une combinaison des formules INDEX et EQUIV, une fois la formule correcte trouvée, il suffit de la traduire en vba (si besoin l'enregistreur de maccro peut là encore t'aider)

Bon, je viens de faire le 1 et 2... et suis assez fier de moi. :lol::lol:

Par contre c est le grand inconnu pour la suite.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub List2Table() Dim LastRowA As Long Dim LastRowB As Long LastRowA = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row Sheets("Sheet1").Range("A1:A" & LastRowA).Copy Sheets("2DTable").Range("A1").PasteSpecial Sheets("2DTable").Range("A1" & LastRowA).RemoveDuplicates Columns:=1, Header:=xlYes Sheets("Sheet1").Range("B1:B" & LastRowA).Copy Sheets("2DTable").Range("B1").PasteSpecial Sheets("2DTable").Range("B1" & LastRowA).RemoveDuplicates Columns:=2, Header:=xlYes LastRowB = Sheets("2DTable").Cells(Rows.Count, 2).End(xlUp).Row Sheets("2DTable").Range("B2:B" & LastRowB).Copy Sheets("2DTable").Range("B1").PasteSpecial Transpose:=True Sheets("2DTable").Range("B2:B" & LastRowB).Clear End Sub

19/02/2019, 10h50
halaster08

1 pièce(s) jointe(s)

Exemple: Avec une rechercheV et en ajoutant une colonne à ton tableau de base

Pièce jointe 451286

A noter que tu peux remplacer les NA par ce qui t'arrange en ajoutant la fonction sierreur à la formule
19/02/2019, 10h52
jbesclapez

Citation:

Envoyé par halaster08

Exemple: Avec une rechercheV et en ajoutant une colonne à ton tableau de base

Pièce jointe 451286

A noter que tu peux remplacer les NA par ce qui t'arrange en ajoutant la fonction sierreur à la formule

Excellent... je vais essayer de monter ca en VBA.

4 pièce(s) jointe(s)

Bonjour,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Stat2DTab()
  Set f = Sheets("BD")
  TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value  ' Array pour rapidité
  colCrit1 = 1: colCrit2 = 2: colOper = 3
  Set Result = f.Range("f1")                                        ' Adresse résultat
  Set d1 = CreateObject("Scripting.Dictionary")    ' Dictionnaire index pour rapidité
  Set d2 = CreateObject("Scripting.Dictionary")
  Dim TblTot(): ReDim TblTot(1 To UBound(TblBD), 1 To UBound(TblBD, 2))
  Dim TblTotLig(): ReDim TblTotLig(1 To UBound(TblBD))
  Dim TblTotCol(): ReDim TblTotCol(1 To UBound(TblBD, 2))
  For i = LBound(TblBD) To UBound(TblBD)
    clé1 = TblBD(i, colCrit1): If d1.exists(clé1) Then lig = d1(clé1) Else d1(clé1) = d1.Count + 1: lig = d1.Count
    clé2 = TblBD(i, colCrit2): If d2.exists(clé2) Then col = d2(clé2) Else d2(clé2) = d2.Count + 1: col = d2.Count
    TblTot(lig, col) = TblTot(lig, col) + TblBD(i, colOper)
    TblTotLig(lig) = TblTotLig(lig) + TblBD(i, colOper)
    TblTotCol(col) = TblTotCol(col) + TblBD(i, colOper)
  Next i
  Result.Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.keys)   ' titre lignes
  Result.Offset(, 1).Resize(1, d2.Count) = d2.keys                        ' titres colonnes
  Result.Offset(1, 1).Resize(d1.Count, d2.Count) = TblTot                 ' stat 2D
  Result.Offset(d1.Count + 1, 1).Resize(, d2.Count) = TblTotCol   ' totaux colonnes
  Result.Offset(1, d2.Count + 1).Resize(d1.Count) = Application.Transpose(TblTotLig) ' totaux lignes
End Sub

Pièce jointe 451297

Si la colonne 3 est du texte, cf SimulTCD

Pièce jointe 451325

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Stat2DTab()
  Set f = Sheets("BD")
  TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value  ' Array pour rapidité
  colCrit1 = 1: colCrit2 = 3: colOper = 2
  Set AdrResult = f.Range("f1")                                 ' Adresse résultat
  Set d1 = CreateObject("Scripting.Dictionary")    ' Dictionnaire index pour rapidité
  Set d2 = CreateObject("Scripting.Dictionary")
  Dim TblRes(1 To 100, 1 To 100)
  For i = LBound(TblBD) To UBound(TblBD)
    clé1 = TblBD(i, colCrit1): If d1.exists(clé1) Then lig = d1(clé1) Else d1(clé1) = d1.Count + 1: lig = d1.Count
    clé2 = TblBD(i, colCrit2): If d2.exists(clé2) Then col = d2(clé2) Else d2(clé2) = d2.Count + 1: col = d2.Count
    TblRes(lig, col) = TblBD(i, colOper)
  Next i
  AdrResult.Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.keys)   ' titre lignes
  AdrResult.Offset(, 1).Resize(1, d2.Count) = d2.keys                        ' titres colonnes
  AdrResult.Offset(1, 1).Resize(d1.Count, d2.Count) = TblRes         '  résultat
  '-- coloriage titres
  AdrResult.Offset(1).Resize(d1.Count).Interior.Color = vbBlack
  AdrResult.Offset(1).Resize(d1.Count).Font.Color = vbWhite
  AdrResult.Offset(, 1).Resize(, d2.Count).Interior.Color = vbBlack
  AdrResult.Offset(, 1).Resize(, d2.Count).Font.Color = vbWhite
  '--- tri
  Set Rng = AdrResult.Resize(d1.Count + 1, d2.Count + 1)    ' tri lignes & colonnes
  Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).Sort key1:=Rng.Cells(2, 1), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortColumns
  Rng.Offset(, 1).Resize(Rng.Rows.Count, Rng.Columns.Count - 1).Sort key1:=Rng.Cells(1, 2), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortRows
End Sub

Boisgontier

Mr Boigontier,

Merci pour votre aide.
J'utilise votre macro Stat2DTab
J'ai changé la donnée colCrit 2 et colOper =3 car en 2eme colonne j'ai mon axe horizontal du tableau et j'ai les valeur en colonne 3

Par contre j'ai une erreur maintenant si je l'utlise sur mes données.
J'ai 50100 valeurs avec 43 attributs (donc 44 colonnes) et 1253 lignes attendues.

EDIT: L'erreur est sur cette ligne
TblRes(lig, col) = TblBD(i, colOper)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Stat2DTab()
  Set f = Sheets("BD")
  TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value  ' Array pour rapidité
  colCrit1 = 1: colCrit2 = 2: colOper = 3
  Set AdrResult = f.Range("f1")                        ' Adresse résultat
  Set d1 = CreateObject("Scripting.Dictionary")        ' Dictionnaire index pour rapidité
  Set d2 = CreateObject("Scripting.Dictionary")
  Dim TblRes(1 To 100, 1 To 100)
  For i = LBound(TblBD) To UBound(TblBD)
    clé1 = TblBD(i, colCrit1): If d1.exists(clé1) Then lig = d1(clé1) Else d1(clé1) = d1.Count + 1: lig = d1.Count
    clé2 = TblBD(i, colCrit2): If d2.exists(clé2) Then col = d2(clé2) Else d2(clé2) = d2.Count + 1: col = d2.Count
    TblRes(lig, col) = TblBD(i, colOper)
  Next i
  AdrResult.Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.keys)   ' titre lignes
  AdrResult.Offset(, 1).Resize(1, d2.Count) = d2.keys                        ' titres colonnes
  AdrResult.Offset(1, 1).Resize(d1.Count, d2.Count) = TblRes                 ' résultat
  '-- coloriage titres
  AdrResult.Offset(1).Resize(d1.Count).Interior.Color = vbBlack
  AdrResult.Offset(1).Resize(d1.Count).Font.Color = vbWhite
  AdrResult.Offset(, 1).Resize(, d2.Count).Interior.Color = vbBlack
  AdrResult.Offset(, 1).Resize(, d2.Count).Font.Color = vbWhite
  '--- tri
  Set Rng = AdrResult.Resize(d1.Count + 1, d2.Count + 1)    ' tri lignes & colonnes
  Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).Sort key1:=Rng.Cells(2, 1), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortColumns
  Rng.Offset(, 1).Resize(Rng.Rows.Count, Rng.Columns.Count - 1).Sort key1:=Rng.Cells(1, 2), _
     Order1:=xlAscending, Header:=xlNo, MatchCase:=False, Orientation:=xlSortRows
End Sub

19/02/2019, 12h53
boisgontierjacques

Le tableau TblRes() n'a pas assez de lignes.

Modifier:

Code:

Dim TblRes(1 To 2000, 1 To 100)

Boisgontier
19/02/2019, 14h37
jbesclapez

Merci!

Par contre la macro fait une erreur de traitement. Elle copie mes données non pas en texte mais en valeur. Exemple: Si j'ai dans une cellule 10E2, alors la macro va écrire le résultat mathématique de 10 exposant 2, soit 100. La macro va écrire 100.
19/02/2019, 14h45
boisgontierjacques

1 pièce(s) jointe(s)

C'est cette ligne qui convertit en numérique

Code:

AdrResult.Offset(1, 1).Resize(d1.Count, d2.Count) = TblRes ' résultat

Modifier :

Code:

TblRes(lig, col) = "'" & TblBD(i, colOper)

Boisgontier
20/02/2019, 10h07
jbesclapez

Merci, je vais essayer ça.
20/02/2019, 21h41
clementmarcotte

Bonjour,

TU ouvres ta liste dans Word
Tu la convertis en tableau
Tu copies-colles le tableau Word dans Excel

Pour les détails, tu regardes ici.