Macro rapidité Scripting.dictionary

Salut les Kracks,

Je souhaiterai optimiser la macro suivante, c'est à dire réduire son temps d'exécution car elle est mal consu, d'ailleurs il n'y a que les mâle qu'on sus!:oops:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Option Explicit   Sub Commentsadd() Application.ScreenUpdating = False     Dim c1 As Range, c2 As Range Dim plage1 As Range, plage2 As Range   Set plage1 = ThisWorkbook.Worksheets("Signatory_Data").Range("F2:F32632") Set plage2 = ThisWorkbook.Worksheets("Client_list2").Range("H2:H36128")   For Each c1 In plage1 'c1= un champ texte string For Each c2 In plage2 ' si c2 contient c1 (parfois le nom match complètement mais parfois il est inclus seulement dans une phrase If c2 Like ("*" + c1 + "*") And c2.Offset(0, -7) = c1.Offset(0, -4) Then 'deuxième conditions = numéro d'identifiant commun c1.Offset(0, 2).Value = c2.Offset(0, 5).Value Debug.Print c1.Address ' me sert pour me situer pendant l'exécution du code sachant qu'il y a + de 30000 lignes à comparer contre + de 30000 End If Next c2 Next c1 Application.ScreenUpdating = True End Sub

---

J'ai entendu parler de scripting.dictionary mais sans comprendre son utilité pour ce genre de code!
Pourriez-vous partager vos connaissances à se sujet?

bonjour
En effet quand on a un certain nombre de lignes a traiter comme toi (+ de 30000 lignes) on utilise des dictionnaires ou des variables tableaux voir les deux

la rapidité est dû au fait que l'on applique la boucle sur les 2 tableaux plutot que le range ,ce qui peux reduire de plus de 80% le temps d'execution

Au plaisir

Bonjour,

Exemple

Suppression de doublons avec Dictionnaire

16.000 lignes
0,26 s

Code:

---

1 2 3 4 5 6 7 8

Sub ListeSansDoublons() Set mondico = CreateObject("Scripting.Dictionary") For Each c In Range("a2", [a65000].End(xlUp)) mondico(c.Value) = "" Next c [C2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) End Sub

---

Suppression de doublons avec lecture dans un tableau & dictionnaire

16.000 lignes
0,04 s

Code:

---

1 2 3 4 5 6 7 8 9

Sub ListeSansDoublons() Set mondico = CreateObject("Scripting.Dictionary") a = Range("a2:a" & [a65000].End(xlUp).Row) ' tableau a(n,1) For i = LBound(a) To UBound(a) mondico(a(i, 1)) = "" Next i [c2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys) End Sub

---

Recherche dans tableau et dictionary

500 recherches dans un tableau 20.000 éléments= 4 sec
500 recherches dans un dictionnaire 20.000 éléments= 0,015 sec


Pour une recherche dans un tableau de 20.000 éléments et une recherche de 2000 valeurs, la fonction perso matricielle ci dessous est 100 fois plus rapide que Recherchev() classique.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Function RechvM(clé As Range, champ As Range, colResult) Application.Volatile Set d = CreateObject("Scripting.Dictionary") a = champ.Value b = clé.Value For i = LBound(a) To UBound(a) d(a(i, 1)) = a(i, colResult) Next i Dim temp() ReDim temp(LBound(b) To UBound(b)) For i = LBound(b) To UBound(b) tmp = b(i, 1) temp(i) = d(tmp) Next i RechvM = Application.Transpose(temp) End Function

---

Ceuzin

Merci à vous deux,

Je vais m'atteler à utiliser le "dico" car je gère de gros dossiers!

Bon W-end!:zzz: