Avez vous un code pour mettre une liste en Tableau?

**jbesclapez** · 19/02/2019, 09h29

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.

**halaster08** · 19/02/2019, 09h35

Bonjour

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

**jbesclapez** · 19/02/2019, 09h47

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 :-)

**halaster08** · 19/02/2019, 10h05

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)

**jbesclapez** · 19/02/2019, 10h29

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.

Par contre c est le grand inconnu pour la suite.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**halaster08** · 19/02/2019, 10h50

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

Nom : 2019_02_19_10_47_38_Microsoft_Excel_Classeur2.jpg
Affichages : 397
Taille : 59,5 Ko

Nom : 2019_02_19_10_47_38_Microsoft_Excel_Classeur2.jpg
Affichages : 397
Taille : 59,5 Ko

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

**jbesclapez** · 19/02/2019, 10h52

Envoyé par halaster08

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

Nom : 2019_02_19_10_47_38_Microsoft_Excel_Classeur2.jpg
Affichages : 397
Taille : 59,5 Ko

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.

**boisgontierjacques** · 19/02/2019, 11h17

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Nom : T2D.gif
Affichages : 229
Taille : 18,4 Ko

Si la colonne 3 est du texte, cf SimulTCD

Nom : T2D2.gif
Affichages : 293
Taille : 41,3 Ko

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**jbesclapez** · 19/02/2019, 12h31

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**boisgontierjacques** · 19/02/2019, 12h53

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

Modifier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Dim TblRes(1 To 2000, 1 To 100)

Boisgontier

**jbesclapez** · 19/02/2019, 14h37

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.

**boisgontierjacques** · 19/02/2019, 14h45

C'est cette ligne qui convertit en numérique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Modifier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Boisgontier

**jbesclapez** · 20/02/2019, 10h07

Merci, je vais essayer ça.

**clementmarcotte** · 20/02/2019, 21h41

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.

Avez vous un code pour mettre une liste en Tableau?

Macros et VBA Excel

Discussions similaires

Partager

Partager