Discussion :

[Djromé]

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!

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
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?

[patricktoulon]

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

[sophieceuzin]

Bonjour,

Exemple

Suppression de doublons avec Dictionnaire

16.000 lignes
0,26 s

Code :

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

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 :

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

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 :

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

[Djromé]

Merci à vous deux,

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

Bon W-end!