IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Optimisation Construction de dictionnaire [XL-2013]


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    mai 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : mai 2018
    Messages : 7
    Points : 5
    Points
    5
    Par défaut Optimisation Construction de dictionnaire
    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 !

  2. #2
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    mars 2007
    Messages
    2 256
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : mars 2007
    Messages : 2 256
    Points : 4 948
    Points
    4 948
    Par défaut
    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
    Cordialement,
    Patrice
    Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.

    Pour dire merci, cliquer sur et quand la discussion est finie, penser à cliquer sur

  3. #3
    Futur Membre du Club
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    mai 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : mai 2018
    Messages : 7
    Points : 5
    Points
    5
    Par défaut
    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

  4. #4
    Futur Membre du Club
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    mai 2018
    Messages
    7
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 31
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels

    Informations forums :
    Inscription : mai 2018
    Messages : 7
    Points : 5
    Points
    5
    Par défaut
    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 !!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Python 3.X] question optimisation valeur de dictionnaire cumulée pour les clef inférieurs
    Par flapili dans le forum Général Python
    Réponses: 5
    Dernier message: 27/02/2019, 17h13
  2. [9.2] Optimiser une recherche dans un dictionnaire clés/valeurs
    Par gorgonite dans le forum Requêtes
    Réponses: 16
    Dernier message: 04/08/2014, 17h34
  3. Construction optimisée d'une image à partir de petites images
    Par NiamorH dans le forum Traitement d'images
    Réponses: 4
    Dernier message: 12/11/2012, 18h16
  4. Construction optimisée d'une image à partir de petites images
    Par NiamorH dans le forum Algorithmes et structures de données
    Réponses: 1
    Dernier message: 01/11/2012, 14h22
  5. VBO, optimiser la construction
    Par le_ptit_lutin dans le forum OpenGL
    Réponses: 8
    Dernier message: 10/04/2010, 16h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo