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 !