Optimisation Construction de dictionnaire

**ArthG** · 01/12/2020, 17h29

Bonjour,

Je poste ici mon premier message pour vous demander de l'aide, ou simplement échanger sur l'optimisation d'une macro Excel.

la macro fonctionne bien.
en entrée :
- Plage_entrée : contenant des valeurs séparées par un caractère de séparation S
- Plage Biblio: plage de cellule, un tableau de 1 ou plusieurs colonnes
- NoCol : Numéro de colonne de la plage biblio de laquelle on veut afficher la valeur
- S : caractère de séparation des valeurs dans une seule cellule

la macro va isoler toutes les valeurs dans la plage A
Elle va chercher chaque valeur dans la plage Biblio.
A chaque fois qu'elle trouve une correpondance (potentiellement plusieurs), la macro renvoie la (les) valeur(s) de la "NoCol" colonne du tableau Plage_Biblio. Un peu comme un rechercheV quoi ...

Mon problème est que lorsque j'étend cette formule pour faire un recherche sur un tableau entier, le temps de calcu est long.
20mn de calcul pour un tableau de 10.000 lignes dans un autre tableau de 10.000 lignes (=plage_biblio)
(la formule se lance donc 10.000 fois, chaque formule Plage_entrée =une unique cellule)

je cherche un moyen de l'optimiser, mais en vain ...
La partie qui prend le plus de temps est la construction du Dico_Biblio qui est un dictionnaire vba (Dico_Biblio (référence) = string de valeur(s) associée(s))

Voici ci dessous le code :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
 
Option Explicit
 
Public Function CHAD(PlageSource1 As Range, Plage_Biblio As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range) As Variant
    Const SansDoublon = False
    CHAD = pCHxD(PlageSource1, Plage_Biblio, NoCol, S, PlageSource2, SansDoublon)
End Function
 
Public Function CHSD(PlageSource1 As Range, Plage_Biblio As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range) As Variant
    Const SansDoublon = True
    CHSD = pCHxD(PlageSource1, Plage_Biblio, NoCol, S, PlageSource2, SansDoublon)
End Function
 
Private Function pCHxD(PlageSource1 As Range, Plage_Biblio As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range, Optional SansDoublon As Boolean = True) As Variant
'###############################################################################
'#### Purpose   : équivalent de la fonction rechercheV mais qui prend en compte les doublons dans la valeur initiale recherchée (pouvant contenir plusieurs cases)
'#### Date      : 01/12/2020
'#### Version   : 5.1
'###############################################################################
'#### PlageSource1  : liste des cases contenant les références que l'on va ensuite chercher dans le tableau
'#### Plage_Biblio  : bibliothèque de valeur où l'on va chercher nos valeurs pour en récupérer les valeurs associées
'#### NoCol         : numéro de colonne où on va chercher la valeur à retourner pour chaque valeur cherchée
'#### S             : optionnel, caractère de séparation des différentes valeurs étudiées, si vide alors "|"
'#### PlageSource2  : optionnel, 2e plage prise en compte dans la liste des valeurs à chercher
'#### Multi         : optionnel, True pour gérer plusieurs résultats par références, Faux si une seule
'###############################################################################
'#### Note de version
'#### 4.0   : 11/02/2020 toute nouvelle version - refonte totale de la fonction pour éviter les imprécisions
'#### 5.0   : 30/11/2020 revue du format pour rassembler CHAD et CHSD
'#### 5.1   : 01/12/2020 tentative d'amélio de perf
'###############################################################################
'#### Notes
'####
 
Dim DicoSource As Object: Set DicoSource = CreateObject("scripting.dictionary")
Dim DicoResultat As Object: Set DicoResultat = CreateObject("scripting.dictionary")
Dim DicoBiblio As Object: Set DicoBiblio = CreateObject("scripting.dictionary")
 
Dim Ref_Text As String
Dim Cel As Object
Dim Item1 As Variant, Item2 As Variant
Dim i As Long, I_Lim As Long
Dim ListTempo() As String
 
' si le nocol est trop élevé par rapport à la plage biblio alors erreur
If Plage_Biblio.Columns.Count < NoCol Then
    pCHxD = CVErr(xlErrRef)
    Exit Function
End If
 
' pour gérer les retours à la ligne
If S = "CH010" Then S = Chr(10)
 
' construction du dico des items d'entrée qu'on va chercher
For Each Cel In PlageSource1
    If IsError(Cel) Then
        pCHxD = CVErr(xlErrValue)
        Exit Function
    Else
        If Cel.Text <> "" Then
            ListTempo = Split(Cel.Text, S)
            For Each Item1 In ListTempo
                If Item1 <> "" Then DicoSource(Item1) = ""
            Next
        End If
    End If
Next
 
' idem sur la 2e plage si elle existe
If Not PlageSource2 Is Nothing Then
    For Each Cel In PlageSource2
        If IsError(Cel) Then
            pCHxD = CVErr(xlErrValue)
            Exit Function
        Else
            If Cel.Text <> "" Then
                ListTempo = Split(Cel.Text, S)
                For Each Item1 In ListTempo
                    If Item1 <> "" Then DicoSource(Item1) = ""
                Next
            End If
        End If
    Next
End If
 
' on constriut le dictionnaire qui contient les valeurs dans lesquelles on va chercher et les valeurs qu'on souhaite retourner
With Plage_Biblio
    I_Lim = .Rows.Count 'raccourci pour la perf
    i = 1: While i <= I_Lim
        If Not IsError(.Cells(i, 1)) And Not IsError(.Cells(i, NoCol)) Then
            Ref_Text = CStr(.Cells(i, 1)) 'raccourci pour la perf
            If Ref_Text <> "" And .Cells(i, NoCol) <> "" Then
                If Not DicoBiblio.Exists(Ref_Text) Then
                    DicoBiblio(Ref_Text) = .Cells(i, NoCol)
                Else
                    DicoBiblio(Ref_Text) = DicoBiblio(Ref_Text) & S & .Cells(i, NoCol)
                End If
            ElseIf .Cells(i, NoCol) = "" Then ' une valeur vide ne signifie pas #NA car on a qd mm trouvé un truc, donc on écrit bien vide et pas #NA
                If Not DicoBiblio.Exists(Ref_Text) Then DicoBiblio(Ref_Text) = ""
            End If
        End If
    i = i + 1: Wend
End With
 
' on construit le résultat final en fonction des correspondances qu'on trouve
If SansDoublon = True Then
    For Each Item1 In DicoSource.Keys
        If DicoBiblio.Exists(Item1) Then
            If DicoBiblio(Item1) = "" Then DicoResultat("") = ""
            For Each Item2 In Split(DicoBiblio(Item1), S)
                DicoResultat(Item2) = ""
            Next
        Else
            DicoResultat("#N/A") = ""
        End If
    Next
    If DicoResultat.Count > 0 Then pCHxD = Join(DicoResultat.Keys, S)
Else
    For Each Item1 In DicoSource.Keys
        If DicoBiblio.Exists(Item1) Then
            If pCHxD = "" Then pCHxD = DicoBiblio(Item1) Else pCHxD = pCHxD & S & DicoBiblio(Item1)
        Else
            If pCHxD = "" Then pCHxD = "#N/A" Else pCHxD = pCHxD & S & "#N/A"
        End If
    Next
End If
 
End Function

J'ai conscience que ça peut être pénible à lire, donc merci d'avance à ceux qui souhaiterait mettre le nez dedans

Bonne journée !

**Patrice740** · 01/12/2020, 17h39

Bonjour,

La lecture des cellules d'un plage est relativement chronophage, il est bien plus rapide de travailler sur un tableau VBA :

Code :

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

1
2
Dim t as variant
  t = Plage_Biblio.Value

**ArthG** · 01/12/2020, 17h43

Mais tu as tellement raison !!!!
Je change ça de suite, je sais pas pourquoi je n'y ai pas pensé avant.
Merci !!

Voici le code final :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 
Option Explicit
 
Public Function CHAD(PlageSource1 As Range, Plage_Biblio As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range) As Variant
    Const SansDoublon = False
    CHAD = pCHxD(PlageSource1, Plage_Biblio, NoCol, S, PlageSource2, SansDoublon)
End Function
 
Public Function CHSD(PlageSource1 As Range, Plage_Biblio As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range) As Variant
    Const SansDoublon = True
    CHSD = pCHxD(PlageSource1, Plage_Biblio, NoCol, S, PlageSource2, SansDoublon)
End Function
 
Private Function pCHxD(PlageSource1 As Range, Plage_Biblio_Range As Range, NoCol As Integer, Optional S As String = "|", Optional PlageSource2 As Range, Optional SansDoublon As Boolean = True) As Variant
'###############################################################################
'#### Purpose   : équivalent de la fonction rechercheV mais qui prend en compte les doublons dans la valeur initiale recherchée (pouvant contenir plusieurs cases)
'#### Date      : 01/12/2020
'#### Version   : 5.1
'###############################################################################
'#### PlageSource1  : liste des cases contenant les références que l'on va ensuite chercher dans le tableau
'#### Plage_Biblio_Range  : range bibliothèque de valeur où l'on va chercher nos valeurs pour en récupérer les valeurs associées
'#### NoCol         : numéro de colonne où on va chercher la valeur à retourner pour chaque valeur cherchée
'#### S             : optionnel, caractère de séparation des différentes valeurs étudiées, si vide alors "|"
'#### PlageSource2  : optionnel, 2e plage prise en compte dans la liste des valeurs à chercher
'#### Multi         : optionnel, True pour gérer plusieurs résultats par références, Faux si une seule
'###############################################################################
'#### Note de version
'#### 4.0   : 11/02/2020 toute nouvelle version - refonte totale de la fonction pour éviter les imprécisions
'#### 5.0   : 30/11/2020 rvue du format pour rassembler CHAD et CHSD
'#### 5.1   : 01/12/2020 tentative d'amélio de perf
'###############################################################################
'#### Notes
'####
 
Dim DicoSource As Object: Set DicoSource = CreateObject("scripting.dictionary")
Dim DicoResultat As Object: Set DicoResultat = CreateObject("scripting.dictionary")
Dim DicoBiblio As Object: Set DicoBiblio = CreateObject("scripting.dictionary")
 
Dim Ref_Text As String
Dim Cel As Object
Dim Item1 As Variant, Item2 As Variant
Dim i As Long, I_Lim As Long
Dim ListTempo() As String
 
Dim Plage_Biblio As Variant
Plage_Biblio = Plage_Biblio_Range.Value
 
' si le nocol est trop élevé par rapport à la plage biblio alors erreur
If Plage_Biblio_Range.Columns.Count < NoCol Then
    pCHxD = CVErr(xlErrRef)
    Exit Function
End If
 
' pour gérer les retours à la ligne
If S = "CH010" Then S = Chr(10)
 
' construction du dico des items d'entrée qu'on va chercher
For Each Cel In PlageSource1
    If IsError(Cel) Then
        pCHxD = CVErr(xlErrValue)
        Exit Function
    Else
        If Cel.Text <> "" Then
            ListTempo = Split(Cel.Text, S)
            For Each Item1 In ListTempo
                If Item1 <> "" Then DicoSource(Item1) = ""
            Next
        End If
    End If
Next
 
' idem sur la 2e plage si elle existe
If Not PlageSource2 Is Nothing Then
    For Each Cel In PlageSource2
        If IsError(Cel) Then
            pCHxD = CVErr(xlErrValue)
            Exit Function
        Else
            If Cel.Text <> "" Then
                ListTempo = Split(Cel.Text, S)
                For Each Item1 In ListTempo
                    If Item1 <> "" Then DicoSource(Item1) = ""
                Next
            End If
        End If
    Next
End If
 
' si pas de valeurs en entrée, on sort
If DicoSource.Count = 0 Then
    pCHxD = CVErr(xlErrNA)
    Exit Function
End If
 
' on constriut le dictionnaire qui contient les valeurs dans lesquelles on va chercher et les valeurs qu'on souhaite retourner
I_Lim = Plage_Biblio_Range.Rows.Count 'raccourci pour la perf
 
i = 1: While i <= I_Lim
    If Not IsError(Plage_Biblio(i, 1)) And Not IsError(Plage_Biblio(i, NoCol)) Then ' on évacue les erreurs
        Ref_Text = CStr(Plage_Biblio(i, 1)) 'raccourci pour la perf
        If Ref_Text <> "" And Plage_Biblio(i, NoCol) <> "" Then 'si les deux snot non vides
            If Not DicoBiblio.Exists(Ref_Text) Then
                DicoBiblio(Ref_Text) = Plage_Biblio(i, NoCol)
            Else
                DicoBiblio(Ref_Text) = DicoBiblio(Ref_Text) & S & Plage_Biblio(i, NoCol)
            End If
        ElseIf Plage_Biblio(i, NoCol) = "" Then ' si la ref est non vide mais que la valeur associées est vide
            ' Une valeur vide ne signifie pas #NA car on a qd mm trouvé un truc, donc on écrit bien vide et pas #NA
            If Not DicoBiblio.Exists(Ref_Text) Then DicoBiblio(Ref_Text) = "" 'on écrit vide et ça sera considéré comme une valeur à part entiere
        End If
    End If
i = i + 1: Wend
 
' on construit le résultat final en fonction des correspondances qu'on trouve
If SansDoublon = True Then
    For Each Item1 In DicoSource.Keys
        If DicoBiblio.Exists(Item1) Then
            If DicoBiblio(Item1) = "" Then DicoResultat("") = ""
            For Each Item2 In Split(DicoBiblio(Item1), S)
                DicoResultat(Item2) = ""
            Next
        Else
            DicoResultat("#N/A") = ""
        End If
    Next
    If DicoResultat.Count > 0 Then pCHxD = Join(DicoResultat.Keys, S)
Else
    For Each Item1 In DicoSource.Keys
        If DicoBiblio.Exists(Item1) Then
            If pCHxD = "" Then pCHxD = DicoBiblio(Item1) Else pCHxD = pCHxD & S & DicoBiblio(Item1)
        Else
            If pCHxD = "" Then pCHxD = "#N/A" Else pCHxD = pCHxD & S & "#N/A"
        End If
    Next
End If
 
End Function

**ArthG** · 01/12/2020, 18h09

Ok, bon ... c'est plutot concluant voire très concluant.
Je passe de 20mn à 3mn.

Merci !!!!
c'est Résolu.

Conclusion, on manipule pas des range, on manipule des tableaux !!

Optimisation Construction de dictionnaire [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager