Object Dictionary et utilisation d'array

Bonjour à tous,

Je me lance dans la manipulation de l'objet Dictionary.

Tout fonctionne parfaitement et à une vitesse grand V cet objet illumine mes journées :).

Cependant, j'aurais aimé savoir si mon code ne pouvait pas être amélioré.

Voici mon code :

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 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46

Sub test() 'Dico Dim MonDico As New Dictionary Dim Mondico2 As New Dictionary Dim tblE Dim tblE2 Dim i As Integer Dim KeyB As String Dim KeyBase As String Dim compt As Integer compt = 1 Set MonDico = CreateObject("Scripting.Dictionary") tblE = ThisWorkbook.Sheets("JUILLET").Range("A1:AJ236") For i = 2 To 236 KeyB = tblE(i, 6) & tblE(i, 7) MonDico.Item(KeyB) = Array(tblE(i, 1), tblE(i, 2), tblE(i, 3), tblE(i, 4), tblE(i, 5), tblE(i, 6), tblE(i, 7), tblE(i, 8), tblE(i, 9), _ tblE(i, 10), tblE(i, 11), tblE(i, 12), tblE(i, 13), tblE(i, 14), tblE(i, 15), tblE(i, 16), tblE(i, 17), tblE(i, 18), tblE(i, 19), _ tblE(i, 20), tblE(i, 21), tblE(i, 22), tblE(i, 23), tblE(i, 24), tblE(i, 25), tblE(i, 26), tblE(i, 27), tblE(i, 28), tblE(i, 29), _ tblE(i, 30), tblE(i, 31)) Next i tblE2 = ThisWorkbook.Sheets("AOUT").Range("A1:AJ240") For i = 2 To 240 KeyBase = tblE2(i, 6) & tblE2(i, 7) If Not Mondico2.Exists(KeyBase) Then Mondico2.Add compt, KeyBase compt = compt + 1 End If Next i For i = 1 To 239 For j = 25 To 30 If MonDico.Exists(Mondico2(i)) Then ThisWorkbook.Sheets("AOUT").Cells(i + 1, j + 1).Value = MonDico(Mondico2(i))(j) End If Next j Next i End sub

---

Ce que je n'arrive pas à faire c'est au niveau de l'array (code en rouge). Au lieu de devoir écrire en dur toutes colonnes de l'array, j'aurais aimé faire une boucle.
Est-ce possible?

Merci d'avance à ceux qui prendront un peu de temps pour me répondre.

Je reste à votre disposition pour plus d'info.

Schoum

re
peu etre que je me trompe dans tes intentions je sais pas sinon

Code:

---

1 2 3 4 5 6

MonDico.Item(KeyB) = application.transpose(application.transpose(application.index(tblE,i,0))) 'Array(tblE(i, 1), tblE(i, 2), tblE(i, 3), tblE(i, 4), tblE(i, 5), tblE(i, 6), tblE(i, 7), tblE(i, 8), tblE(i, 9), _ 'tblE(i, 10), tblE(i, 11), tblE(i, 12), tblE(i, 13), tblE(i, 14), tblE(i, 15), tblE(i, 16), tblE(i, 17), tblE(i, 18), tblE(i, 19), _ 'tblE(i, 20), tblE(i, 21), tblE(i, 22), tblE(i, 23), tblE(i, 24), tblE(i, 25), tblE(i, 26), tblE(i, 27), tblE(i, 28), tblE(i, 29), _ 'tblE(i, 30), tblE(i, 31))

---

on recupere la ligne i complete du tableau on obtien un array 1 dim
on le transpose on obtient une colonne 31 lignes
on le retranspose on obtien un tableau 2 dim(1 ligne 31 colonnes )
tu a donc ton tableau 1 ligne comme tu l'avait

peut etre que en regardant ton code ceci correspondrait exatement a ce que font tes lignes rouges:

Code:

---

application.index(tblE,i,0)

---

mais je le redis je connais pas tes intentions je ne sais pas si tu souhaite vraiment faire un array 1 dim ou 2 dim

Top!
Merci beaucoup pour ce retour. J’essaie de suite et reviens vers toi.
Mon intention est juste d’eviter D’ecrire un Array aussi long dans mon code.
Le but ici est de créer un index (KeyB) dans mon dictionary MonDico qui sera relié à des données se trouvant dans 31 colonnes d’un tableau d’une feuille excel. Comme ça, je peux faire des recherches sur l’index et ressortir certaines données. J’ai lu que c’etait une des méthodes les plus rapides. Je ne sais pas trop si je suis assez clair.

Bonjour,

2 exemples classique d'utilisation d'Array et de dictionnaire

Boisgontier

@Boisgontier
Merci beaucoup.

J'ai regardé tout ça et je voulais savoir, pour le classeur RegroupeUniquesCode, supposons que j'ai 10 (ou +) colonnes et aucun doublon sur les lignes, il faut donc que je mette autant d'argument que j'ai de colonne sur cette ligne : d1(Tbl(i, 1) & "|" & Tbl(i, 2)).

Exemple:

Code:

---

d1(Tbl(i, 1) & "|" & Tbl(i, 2)& "|" & Tbl(i, 3) & "|" & Tbl(i, 4) & "|" & Tbl(i, 5) & "|" & Tbl(i, 6) & "|" & Tbl(i, 7) & "|" & Tbl(i, 8) & "|" & Tbl(i, 9)& "|" & Tbl(i, 10))

---

@patricktoulon
J'ai testé et ça marche aussi. Seule différence le temps de traitement. Avec ta méthode cela prend en moyenne 1sec de plus (sur 239 lignes)... Ce n'est qu'un détail je sais...

Merci encore.

Citation:

---

Code:

---

d1(Tbl(i, 1) & "|" & Tbl(i, 2)& "|" & Tbl(i, 3) & "|" & Tbl(i, 4) & "|" & Tbl(i, 5) & "|" & Tbl(i, 6) & "|" & Tbl(i, 7) & "|" & Tbl(i, 8) & "|" & Tbl(i, 9)& "|" & Tbl(i, 10))

---

---

-Il faut faire une boucle - qui sera très rapide puisque sur un Array()-
-Ce qui est lent en VBA, c'est l'accès aux cellules une par une(en lecture ou écriture)
-Le principe général consiste à transférer un champ(range) dans un Array()
-Créer éventuellement des dicos à partir de l'Array()
-Traiter les Arrays et dictionnaires et alimenter un Array de retour
-Transférer l'Array() de retour dans un champ

Boisgontier

Compris, merci pour ces explications supplémentaires.

J'essaie de boucler mais je pense que je dois faire une erreur quelque part... Du moins j'ai dû mal à voir comment créer la boucle et à tout bien comprendre.

J'ai repris votre code pour que ce soit plus simple pour voir si ça marche et j'ai donc fait une boucle de 1 à 2 (pour les deux colonnes, juste pour comprendre le système.

j'en suis là : (la partie en rouge est celle que j'essaie de modifier pour créer la boucle

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 29 30

Sub RegroupeUniquesCode() Set f = Sheets("bd") Set d = CreateObject("Scripting.Dictionary") Set d1 = CreateObject("Scripting.Dictionary") Tbl = f.Range("A2:B" & f.[a65000].End(xlUp).Row).Value For i = LBound(Tbl) To UBound(Tbl) ' élimination doublons nuances If Tbl(i, 2) <> "" Then For j = 1 To 2 MyVar = Myvar & d1(Tbl(i, j)) & "|" Next j MyVar = "" End If Next i For Each c In d1.keys ' regroupement par code a = Split(c, "|") d(a(0)) = d(a(0)) & a(1) & "|" Next c Set f2 = Sheets("résultat") n = d.Count Dim TblRes: ReDim TblRes(1 To d.Count, 1 To 2) i = 0 For Each c In d.keys i = i + 1 TblRes(i, 1) = c: TblRes(i, 2) = d(c) Next c f2.[A2].Resize(d.Count, 2) = TblRes Application.DisplayAlerts = False f2.[B2].Resize(d.Count).TextToColumns Other:=True, OtherChar:="|" f2.Cells.EntireRow.AutoFit End Sub

---

Si des nuances existent en colonnes B,C,D,E:

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

Sub RegroupeUniquesCode() Set f = Sheets("bd") Set d = CreateObject("Scripting.Dictionary") Set d1 = CreateObject("Scripting.Dictionary") Tbl = f.Range("A2:E" & f.[a65000].End(xlUp).Row).Value For i = LBound(Tbl) To UBound(Tbl) ' élimination doublons nuances For k = 1 To 4 If Tbl(i, k + 1) <> "" Then d1(Tbl(i, 1) & "|" & Tbl(i, k + 1)) = "" Next k Next i For Each c In d1.keys ' regroupement par code a = Split(c, "|") d(a(0)) = d(a(0)) & a(1) & "|" Next c Set f2 = Sheets("résultat") n = d.Count Dim TblRes: ReDim TblRes(1 To d.Count, 1 To 2) i = 0 For Each c In d.keys i = i + 1 TblRes(i, 1) = c: TblRes(i, 2) = d(c) Next c f2.[A2].Resize(d.Count, 2) = TblRes Application.DisplayAlerts = False f2.[B2].Resize(d.Count).TextToColumns Other:=True, OtherChar:="|" f2.Cells.EntireRow.AutoFit End Sub

---

Il y a 30.000 lignes. Le temps d'exécution est très faible.

Pour comprendre ce que contient le dictionnaire d1, on peut ajouter après la boucle For i.. Next i :

Code:

---

f.[G1].Resize(d1.Count) = Application.Transpose(d1.keys)

---

Boisgontier

Merci pour ce nouveau retour.

Je vais essayer tout ça et l'adapter à mon projet.

Une dernière question, si aucune nuance existe en colonne B,C,D,E, le code est sensiblement le même ou il y a une réelle différence?

Par exemple, j'ai les colonnes C et D de vide et les B et E avec des données, j'aimerais quand même rapatrier les colonnes C et D vide pour que quand je retranscrive mon dico dans un feuille excel par le biais d'une variable tableau, pour chaque ligne j'ai bien le même nombre de colonne.

En bidouillant j'ai réussi à faire ce que je voulais.
Merci encore pour votre aide.

A bientôt.