[VBA] Améliorer vitesse d'exécution macro (recherche)

Le 13/04/2020 à 10:00

Bonsoir,

J'exécute la macro suivante, pour une recherche sur 1 (à 2) colonne(s), entre deux grosses tables.

Public Sub maj_bdc()
Dim lrst&, lcst&, lrtx&, c As Variant, lbnm As Byte, Rtxrf As Range, rng As Range, a&

Call Set_Feuilles
Call opt_act

With st
    lrst = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lcst = .UsedRange.Columns.Count
    lbnm = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column
    nv = .Range("1:1").Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column
        For a = 2 To lrst
            With tx
                lrtx = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                cib = .Range("1:1").Find("NOM_VALIDE", LookIn:=xlValues, Lookat:=xlWhole).Column
                cib1 = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column
                Set Rtxrf = .Range(.Cells(2, cib1), .Cells(lrtx, cib1))
                    On Error Resume Next
                    Set res = Rtxrf.Find(st.Cells(a, lbnm), LookIn:=xlValues, Lookat:=xlWhole)
                        If Not res Is Nothing Then
                            st.Cells(a, nv) = res.Offset(, 3)
                        Else
                            st.Cells(a, nv) = "nn"
                        End If
                End With
        Next a
End With

Le résultat est bon, mais le temps d'exécution est très long ()

Auriez-vous une solution pour optimiser la vitesse d'exécution de ce code ?

Par exemple : déclarer des tableaux et faire les modifications dans le tableau ?

Utiliser autre chose que "find" ?

Je joins un document, avec la macro associée, sur quelques données seulement.

Je vous remercie de votre attention

Bonne journée !

26croisement-tables-2.xlsm (33.63 Ko)
Le 13/04/2020 à 14:15

Bonjour,

une proposition.

utilisation d'un tableau pour stocker le résultat avant de le mettre dans la feuille.

isolement des instructions qu'il n'est pas nécessaire de répéter pour chaque ligne (recherche des colonnes, détermination du nombre de lignes, détermination de la plage de recherche ...)

On pourrait encore améliorer la vitesse en utilisant un dictionnaire, mais je pense que tu travailles sur mac, cette option n'est pas disponible.

Public Sub maj_bdc()
    Dim lrst&, lcst&, lrtx&, c As Variant, lbnm As Byte, nv As Byte, cib As Byte, cib1 As Byte, Rtxrf As Range, res As Range, a&, tablo()

    Call Set_Feuilles
    Call opt_act

    With tx
        lrtx = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        cib = .Range("1:1").Find("NOM_VALIDE", LookIn:=xlValues, Lookat:=xlWhole).Column
        cib1 = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column
        Set Rtxrf = .Range(.Cells(2, cib1), .Cells(lrtx, cib1))
    End With
    With st
        lrst = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
        lcst = .UsedRange.Columns.Count
        lbnm = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column
        nv = .Range("1:1").Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column
        ReDim tablo(1 To lrst, 1 To 1)
    End With
    For a = 2 To lrst
        Set res = Rtxrf.Find(st.Cells(a, lbnm), LookIn:=xlValues, Lookat:=xlWhole)
        If Not res Is Nothing Then
            tablo(a - 1, 1) = res.Offset(, 3)
        Else
            tablo(a - 1, 1) = "NN"
        End If
    Next a
    st.Cells(2, nv).Resize(lrst, 1) = tablo
Le 13/04/2020 à 14:23

Bonjour,

Je travaille sur Excel 2016, OS Windows 10.

Merci pour votre proposition, je vais tester ça de ce pas !

Le 13/04/2020 à 14:37

bonjour,

solution avec dictionnaire

Public Sub maj_bdc()
    Dim i&, lrst&, lcst&, lrtx&, c As Variant, lbnm As Byte, nv As Byte, cib As Byte, cib1 As Byte, Rtxrf As Range, res As Range, a&, tablo(), dict As Object, tablo1, tablo2, tablo3

    Call Set_Feuilles
    Call opt_act
    Set dict = CreateObject("scripting.dictionary") 'dictionnaire associant lb_nom avec la colonne se trouvant 3 colonnes plus à droite (nom_valide)
    With tx
        lrtx = .UsedRange.SpecialCells(xlCellTypeLastCell).Row 'dernière  ligne de tx
        cib = .Range("1:1").Find("NOM_VALIDE", LookIn:=xlValues, Lookat:=xlWhole).Column 'inutilisé ?
        cib1 = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column 'n° de colonne de LB_NOM sur tx
        tablo1 = .Range(.Cells(2, cib1), .Cells(lrtx, cib1)) 'array contenant la colonne LB_nom de tx
        tablo2 = .Range(.Cells(2, cib1 + 3), .Cells(lrtx, cib1 + 3)) ' array contenant le colonne LB_nom +3 de tx (nom_valide)
        For i = LBound(tablo1) To UBound(tablo1) 'chargement du dictionnaire
            dict(tablo1(i, 1)) = tablo2(i, 1)
        Next i
    End With
    With st
        lrst = .UsedRange.SpecialCells(xlCellTypeLastCell).Row 'dernière ligne de st
        lcst = .UsedRange.Columns.Count 'dernière colonne de st
        lbnm = .Range("1:1").Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column 'colonne de lb_nom de st
        nv = .Range("1:1").Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column 'colonne de nom_valide de st à remplir
        ReDim tablo(1 To lrst, 1 To 1) 'tableau avec le resultat à mettre en colonne nv
        tablo3 = .Range(.Cells(2, lbnm), .Cells(lrst, lbnm)) 'array contenant les noms de st à rechercher dans ledictionnaire
    End With
    For a = 1 To UBound(tablo3) ' on prend les noms de tablo3 (tx)
        If dict.exists(tablo3(a, 1)) Then 'si dans le dictionnaire
            tablo(a, 1) = dict(tablo3(a, 1)) 'on met le nom_valide associé à ce nom lb_nom
        Else
            tablo(a, 1) = "NN" 'sinon on met NN
        End If
    Next a
    st.Cells(2, nv).Resize(lrst, 1) = tablo ' on met le résultat dans la feuille st
Le 13/04/2020 à 14:43

Bonjour le fil, bonjour le forum,

Arf ! j'arrive encore trop tard... J'envoie malgré tout même si ça me paraît très proche de notre Acide ami...

Sub maj_bdc_T()
Dim TSt As Variant 'déclare la variable TSt (Tableau onglet St)
Dim TTx As Variant 'déclare la variable TTx (Tableau onglet Tx)
Dim CS As Integer 'déclare la variable CS (Colonne Source)
Dim CR As Integer 'déclare la variable CR (Colonne Résultat)
Dim CC As Integer 'déclare la variable CC (Colonne Cible)
Dim TMP() As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TEST As Boolean 'déclare la variable TEST

Call Set_Feuilles
Call opt_act
TSt = St.Range("A1").CurrentRegion 'définit le tableau TSt
TTx = Tx.Range("A1").CurrentRegion 'définit le tableau TTx

CS = St.Rows(1).Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column 'définit la colonne source CS
CR = St.Rows(1).Find("NOM_VALIDE_TAXREF", LookIn:=xlValues, Lookat:=xlWhole).Column 'définit la colonne résultat CR
CC = Tx.Rows(1).Find("LB_NOM", LookIn:=xlValues, Lookat:=xlWhole).Column 'définit la colonne cible CC
ReDim TMP(1 To UBound(TSt, 1), 1 To 1) 'redimensionne le tableau temporaire TMP
TMP(1, 1) = "NOM_VALIDE_TAXREF"
For I = 2 To UBound(TSt, 1) 'boucle 1 : sur toutes les lignes I du tableau TSt (en partant de la seconde)
    TEST = False 'initialise la variablre TEST
    For J = 2 To UBound(TTx, 1) 'boucle 2 : sur toutes les lignes J du tableau TTX (en partant de la seconde)
        'condition : si la donnée ligne I , colonne CC de TSt est égale à la donnée ligne J colonne CS de TTx
        If TSt(I, CC) = TTx(J, CS) Then
            TMP(I, 1) = TTx(J, CS) 'récupère la donnée ligne J colonne CS de TTx dans le tableau temporairte TMP
            TEST = True 'redéfinit la variable TEST
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
    If TEST = False Then TMP(I, 1) = "NN" 'si TEST est [vrai], définit la variable TMP(I,1)
Next I
St.Cells(1, CR).Resize(UBound(TMP, 1), 1) = TMP 'renvoie le tableau temporaire TMP dans la cellule ligne 1 colonne CR de l'onglet St
Call opt_fin
End Sub
Le 13/04/2020 à 19:00

Bonjour,

J'ai testé les deux macros que vous proposez, la première, réalisée par h2so4 est rapide dans son exécution, mais le nombre de ligne final n'est pas le même (il y en a en plus) et énormément de résultats correspondent au résultat de la première ligne recherchée (Nonea erecta apparaît dans de multiples cellules, sans que ce soit le résultat logique).

La macro proposée par ThauThème semble utiliser plus de mémoire que ce que mon ordinateur possède, il ne parvient (pour le moment) pas à terminer l'exécution.

Merci pour votre aide ! Vue la taille de ma table, la solution d'h2so4 semble s'exécuter plutôt rapidement (c'est même plutôt surprenant comparé à tout ce que j'avais testé jusque là !) ; il reste juste le petit souci du résultat qui n'est pas le bon

Le 13/04/2020 à 21:12

Bonsoir,

Recherche multi-mots multi-colonnes avec dictionnaire des mots de la BD.

Boisgontier

8copie-de-recherchemutimotsmulticolonnesscrolletou-1.xlsm (99.66 Ko)
Le 14/04/2020 à 15:11

bonjour,

il reste juste le petit souci du résultat qui n'est pas le bon

le résultat avec le fichier test que tu as mis, est-il celui attendu ? sinon peux-tu indiquer l'erreur ?

si résultat avec fichier test est ok, mais pas avec un autre fichier, merci de mettre cet autre fichier ou de mettre un exemple où cela ne fonctionne pas.

Le 14/04/2020 à 16:15

Bonjour,

Tout d'abord, merci à @Boisgontierjacques pour le document proposé. La solution d'h2so4 m'a semblé tout à fait correspondre à ce que j'essayais de faire, c'est pourquoi j'ai poursuivi sur cette macro pour essayer de trouver ce qui clochait.

Finalement, je vous remercie grandement pour votre aide @h2so4 ; le petit problème dans les résultats venaient d'un filtre que j'avais oublié. J'ai passé un long moment à en chercher l'origine dans la macro, à force de la relancer encore et encore, en pas à pas, j'ai fini par tomber sur une ligne filtrée... C'était juste ça.

L'exécution du code se fait en quelques secondes pour une comparaison entre deux bases de 106 000 et 98 000 lignes ! C'est fabuleux !

En voyant le résultat final, j'ai constaté un autre petit souci, qui est que certaines valeurs dans la colonne NOM_VALIDES_TAXREF (où est collé "tablo") sont fausses, car la données recherchée dans la colonne "LB_NOM" existe plusieurs fois (le résultat de la comparaison est donc pas toujours bon).

Pour résoudre le problème j'ai ajouté des informations (concaténation avec une autre colonne) pour des comparaisons sur des valeurs uniques.

Tout fonctionne à merveille. Du coup j'ai étoffé un peu l'une des tables. Et finalement toujours 1 secondes ou 2 pour traiter 50 000 lignes de plus .

Je vais certainement m'en resservir pour accélérer les différentes procédures quand ce sera possible !

Pour que la macro puisse trouver tous les résultats, il me reste un problème à résoudre qui est l'encodage source des différentes tables qui est mal prit en charge

Bonne journée !

Le 28/04/2020 à 10:12

bonjour,

pour des explications sur l'utilisation d'un dictionnaire, je te renvoie vers notre vénéré Boisgontier

Rechercher des sujets similaires à "vba ameliorer vitesse execution macro recherche"