Mixer un Dictionnary avec un Array

Version imprimable

Hello,

En continuant mon exploration, je suis tombe sur http://silkyroad.developpez.com/vba/tableaux/#LIX

J'ai utilise ensuite un dictionnaire (apres plusieurs essais) pour essayer de centraliser des donnees venus de plusieurs fichiers differents. La donnee principale que je cherche a obtenir est ma Key. Cependant, associee a cette Key (une suite de chiffres), j'aimerais y associer quatre elements contenu dans chacun de mes fichiers sur la meme ligne que l'element key - mais des colonnes differentes.

Via le dictionnaire, j'ai reussi a rameuter la key et un seul des elements (avec le Add Key, Item). J'ai cependant luqu'il etait possible d'utiliser un Array dans le dictionnaire.

J'aimerais pouvoir centraliser quatre informations et non pas deux en mettant trois de mes informations dans un Array.

Est ce possible ? L'array vous semble t-il la bonne piste ? Des idees pour m'aider ?

Le code ci-dessous est bien incomplet et c'est ma premiere tentative et utilisation de Array
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Set Unique = CreateObject("Scripting.Dictionary") For Each Col In plage If Not Unique.Exists(Col.Value) Then Unique(Col.Value) = Array("a", "b") End If Next Col Worksheets("Sheet1").Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.Keys) Worksheets("Sheet1").Range("b2:b" & Unique.Count + 1) = Application.Transpose(Unique.Items)

J'ai cette fonction qui te reforme un array 2d à partir d'un dic de la forme (key => array)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
' option base 1
Function fromDICtoTAB(DIC)
    Dim el
    Dim i&, j&, n&
    Dim arr()
    Dim TAB_tmp
 
    el = DIC.items
    n = UBound(el(0))
    ReDim TAB_tmp(DIC.Count, n)
    i = 1
    For Each el In DIC
        arr = DIC(el)
        For j = 1 To n
            TAB_tmp(i, j) = arr(j)
        Next j
        i = i + 1
    Next el
    fromDICtoTAB = TAB_tmp
End Function

Tu pourrais donc remplacer ta ligne

Code:

1
2
 
Worksheets("Sheet1").Range("b2:b" & Unique.Count + 1) = Application.Transpose(Unique.Items)

par

Code:

1
2
 
Worksheets("Sheet1").Range("b2:b" & Unique.Count + 1) = fromDICtoTAB(Unique)

On peut imaginer une petite modif dans la fonction pour insérer la clé en colonne 1

1 pièce(s) jointe(s)

Bonjour,

Faire une recherche Google: tableau encapsule dans dictionnaire

Exemple de tableau 2D encapsulé dans un dictionnaire

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub ArrayEncapsuléDico()
  Set d = CreateObject("Scripting.Dictionary")
  a = [A2:C5]
  For i = LBound(a) To UBound(a)
    d.Item(a(i, 1)) = Array(a(i, 1), a(i, 2), a(i, 3))
  Next i
  '--accès à la ville de Durand
  [k2] = d("Durand")(1)
  '---suppression d'une ligne
  d.Remove ("Espinasse")
  '----- affichage du tableau
  b = d.items         ' dictionnaire dans array b(,)
  'MsgBox b(1)(2)     ' accès à un item de b(,)
  For c = 1 To 3
    [F2].Offset(, c - 1).Resize(d.Count, 1) = Application.Index(b, , c)
  Next c
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub ArrayEncapsuléDico()
  Set d = CreateObject("Scripting.Dictionary")
  a = [A2:C6]
  For i = LBound(a) To UBound(a)
    d.Item(a(i, 1)) = Array(a(i, 1), a(i, 2), a(i, 3))
  Next i
  '--accès à la ville de Durand
  [k2] = d("Durand")(1)
  '---suppression d'une ligne
  d.Remove ("Espinasse")
  '----- affichage du tableau dans le tableur
  b = Application.Transpose(Application.Transpose(d.items))    ' dictionnaire dans array b(1 to n,1 to 3)
  [F2].Resize(UBound(b), UBound(b, 2)) = b
  'MsgBox b(1, 2)    ' accès à un item de b(,)
End Sub

Boisgontier
http://boisgontier.free.fr

25/04/2016, 18h01
Deuffr
Je prends le temps de tester vos deux approches (et de bien les comprendre surtout) et je vous reponds !

J'ai une erreur a cet endroit la.

Je pense que je me fous dedans entre les valeurs dans la plage et les dimensions de l'arra je pense...
a = A1:S16000
BUN et BIN sont les numeros de colonnes des elements que je souhaite integrer a mon array
Code:

1 2 3 4 5 6 7 8 For Each Col In plageCTN If Not Unique.Exists(Col.Value) Then Unique.Item(a(Col.Row, 1)) = Array(a(Col.Row, BUN), a(Col.Row, BIN)) End If Next Col
J'ai regarde ta reponse Maths, et mon cerveau a pris feu ^^ J'ai pas bien compris ce qu'il se passait

Bonjour,

Il est également possible de faire un dictionnaire de dictionnaires, du genre:

Code:

1
2
3
4
5
6
7
8
Set dico = New Scripting.Dictionary
 
Set dico("Batman") = New Scripting.Dictionary
dico("Batman")("Voiture") = "Batmobile"
dico("Batman"("Ville") = "Gotham City"
 
Set dico("Superman") = New Scripting.Dictionary
etc

26/04/2016, 10h03
mathspountz

Citation:

Envoyé par Deuffr

J'ai regarde ta reponse Maths, et mon cerveau a pris feu ^^ J'ai pas bien compris ce qu'il se passait

^^ j’essaie une explication de texte :

En gros quand tu manipules des données il faut les stocker dans un array à deux dimensions. Mais en vba on est bien embété car la première dimension est fixe à partir du redim.
Donc la solution est de stocker les infos dans un dic, qui lui n'a pas de longueur fixe. En mettant des arrays en item, on règle le problème de la deuxième dimension.

Maintenant tout ce qu'il manque c'est un moyen de coller les infos dans un onglet. Vba ne sait le faire qu'à partir d'un array. J'ai donc créé cette fonction qui te converti ton dic à deux dimensions en un array à deux dimensions pour pouvoir le coller. (ou faire d'autres manip ayant trait aux arrays).

Donc pas vraiment besoin de comprendre la fonction, en gros tu lui donnes à manger un dic (clé=>array(x,y,z)) et il te renvoi un array(x,y,z) avec autant de ligne que tu avais de clés.

Citation:

Envoyé par mathspountz

^^ j’essaie une explication de texte :

En gros quand tu manipules des données il faut les stocker dans un array à deux dimensions. Mais en vba on est bien embété car la première dimension est fixe à partir du redim.
Donc la solution est de stocker les infos dans un dic, qui lui n'a pas de longueur fixe. En mettant des arrays en item, on règle le problème de la deuxième dimension.

Maintenant tout ce qu'il manque c'est un moyen de coller les infos dans un onglet. Vba ne sait le faire qu'à partir d'un array. J'ai donc créé cette fonction qui te converti ton dic à deux dimensions en un array à deux dimensions pour pouvoir le coller. (ou faire d'autres manip ayant trait aux arrays).

Donc pas vraiment besoin de comprendre la fonction, en gros tu lui donnes à manger un dic (clé=>array(x,y,z)) et il te renvoi un array(x,y,z) avec autant de ligne que tu avais de clés.

Understood, j'avais besoin d'un rafraichissement sur les fonctions a vrai dire...

Mon probleme vient du fait que je n'arrive pas a creer mon dico key => array pour l'instant.

Le code bloque sur :
Code:

1 2 3 4 5 6 7 8 9 For Each Col In plageCTN If Not Unique.Exists(Col.Value) Then ==>> Unique.Item(a(Col.Row, 1)) = Array(a(Col.Row, BUN), a(Col.Row, BIN)) End If Next Col

Citation:
Envoyé par Promethee25
Bonjour,

Il est également possible de faire un dictionnaire de dictionnaires, du genre:
Code:

1 2 3 4 5 6 7 8 Set dico = New Scripting.Dictionary Set dico("Batman") = New Scripting.Dictionary dico("Batman")("Voiture") = "Batmobile" dico("Batman"("Ville") = "Gotham City" Set dico("Superman") = New Scripting.Dictionary etc
Hello, Merci pour le tips. Petite precision sur ce sujet -> l'item de la premiere cle est la cle du second dictionnaire, n'est ce pas ?

Code:

1
2
3
4
5
6
7
8
9
For Each Col In plageCTN
    
    
        If Not Unique.Exists(Col.Value) Then
       Unique.Item(Col.Value) = Array(Cells(Col.Row, BUN), Cells(Col.Row, BIN))
        
        
        End If
  Next Col

Ca marche mieux comme cela je pense

J'ai l'impression que mon array fonctionne lorsque je le deroule maintenant. Cependant, j'arrive pas a le coller (ahaha ^^). Ni avec le Appli.Transpose, ni avec ta fonction. voila ou j'en suis dans mon code.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 For Each Col In plageCTN If Not Unique.Exists(Col.Value) Then Unique.Item(Col.Value) = Array(Cells(Col.Row, BUN), Cells(Col.Row, BIN)) End If Next Col WBK.Close False fichier = Dir() Loop Workbooks.Add Worksheets("Sheet1").Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.Keys) Worksheets("Sheet1").Range("b2:d" & Unique.Count + 1) = Application.Transpose(Unique.Items)
Sur la fonction de Maths, j'ai une erreur d'objet a ce niveau :
Code:

1 2 TAB_tmp(i, j) = arr(j)
Malgre le tutoriel de Jacquesboisgontier, je vois pas ce qui bloque ici ...

26/04/2016, 12h25
mathspountz

Es-tu bien en Option Base 1 ?

Voila mon code fonctionnel :)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
   For Each Col In plageCTN
 
        If Not Unique.Exists(Col.Value) Then
        Unique.Item(Col.Value) = Array(Cells(Col.Row, BUN).Value, Cells(Col.Row, BIN).Value, fichier)
 
        End If
  Next Col
End If
 
 
WBK.Close False
 
    fichier = Dir()
Loop
 
Workbooks.Add
Worksheets("Sheet1").Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.Keys)
 
For C = 1 To 3
    [A2].Offset(, C).Resize(Unique.Count, 1) = Application.Index(Unique.items, , C)
Next C

26/04/2016, 13h07
Promethee25

Citation:

Envoyé par Deuffr

Hello, Merci pour le tips. Petite precision sur ce sujet -> l'item de la premiere cle est la cle du second dictionnaire, n'est ce pas ?

Non: l'item de la première clé est le (sous-)dictionnaire; il est de classe Dictionary.
26/04/2016, 13h23
Deuffr

Citation:

Envoyé par Promethee25

Non: l'item de la première clé est le (sous-)dictionnaire; il est de classe Dictionary.

Ca a l'air effectivement assez puissant ! Malheureusement, mes donnees ne sont pas suffisamment structurees pour avoir une conbinaison de deux dicctionnaire. Mais j'y penserais a l'avenir !