XL 2010 Accélération de Vlookup VBA

Strick-TD · 11 Décembre 2020

Bonjour à tous,

Je suis encore débutant sur VBA et je suis en train de mettre en place une rechercheV sur deux classeurs.
Actuellement ma rechercheV fonctionnent très bien, le problème est qu'elle fonctionne pour un nombre de ligne faible et j'en ai besoin sur 8.000 lignes environ.
Sauriez-vous comment modifier ou changer complétement cette formule afin qu'elle se déroule rapidement sur 8.000 lignes s'il vous plaît ?
Ci-dessous ma macro, mon but est que "i" puisse aller jusqu'à 8.000 rapidement.

VB:

Sub RechercheV()


Dim DB_Articles As String

Dim N_BB, Prix As String

Dim i As Integer


Application.ScreenUpdating = False



    i = 2

    While i < 100

        


        cellule = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Cells(i, 17).Value


        'Dans classeur TEST_PRIX

        Workbooks("DB Articles.xlsx").Activate

      

        Prix = Workbooks("DB Articles.xlsx").Sheets("Synthèse").Application.IfError(Application.VLookup(cellule, Range("C2:D10000"), 2, False), 0)

                  

        'Dans classeur Test

        ThisWorkbook.Activate

        ThisWorkbook.Worksheets("Test").Cells(i, 18) = Prix

        

        i = i + 1

        

    Wend



End Sub

Rouge · 12 Décembre 2020

Bonjour job75

Effectivement on peut faire plus rapide

VB:

Sub RechercheV2()
    Dim DerLig As Long
    deb = Timer
    Application.ScreenUpdating = False
    DerLig = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)) = "=VLOOKUP(RC[-1],'[DB Articles.xlsx]Synthèse'!C3:C4,2,0)"
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)).Value = ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)).Value
    MsgBox "Durée: " & Timer - deb
End Sub

Cdlt

Rouge · 12 Décembre 2020

Bonjour,

Essayez ceci

VB:

Sub RechercheV()
    Dim DB_Articles As String
    Dim N_BB
    Dim i As Long, DerLig As Long
    
    deb = Timer
    Application.ScreenUpdating = False
    DerLig = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row
    ReDim Prix(DerLig) As Double
    i = 1
    For Each cellule In Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q2:Q" & DerLig)
        'Dans classeur TEST_PRIX
        With Workbooks("DB Articles.xlsx").Sheets("Synthèse").Columns(3)
            Set x = .Find(cellule, lookat:=xlWhole)
            If Not x Is Nothing Then Prix(i) = Workbooks("DB Articles.xlsx").Sheets("Synthèse").Cells(x.Row, "D") Else: Prix(i) = 0
        End With
        i = i + 1
    Next
    
    'Dans classeur Test
    ThisWorkbook.Activate
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)) = Application.Transpose(Prix())
    
    MsgBox "Durée: " & Timer - deb
End Sub

Cdlt

job75 · 12 Décembre 2020

Bonjour Strick-TD, Rouge,

@Rouge il faut savoir que la méthode Find est lente et utilisée dans une boucle ce sera très long.

A+

Rouge · 12 Décembre 2020

Bonjour job75

Effectivement on peut faire plus rapide

VB:

Sub RechercheV2()
    Dim DerLig As Long
    deb = Timer
    Application.ScreenUpdating = False
    DerLig = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)) = "=VLOOKUP(RC[-1],'[DB Articles.xlsx]Synthèse'!C3:C4,2,0)"
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)).Value = ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)).Value
    MsgBox "Durée: " & Timer - deb
End Sub

Cdlt

job75 · 12 Décembre 2020

Entrer la formule RECHERCHEV par VBA ne résout pas le problème posé au post #1.

Pour aller vite il faut utiliser des tableaux VBA et le Dictionary, plusieurs exemples sur ce forum.

Rouge · 12 Décembre 2020

"Entrer la formule RECHERCHEV par VBA ne résout pas le problème posé au post #1. "

Oui , je n'ai pas utilisez les tableaux ou les dictionnaires, mais il y a quand même une grosse différence avec la demande initiale. Chez moi, avec plus de 10000 lignes cela tourne autour d' 1 seconde, je sais aussi qu'avec l'emploi des dictionnaires on va tomber à quelques millisecondes, mais bon, comme Strick-TD ne se manifeste pas!!!

Strick-TD · 12 Décembre 2020

Rouge à dit:
"Entrer la formule RECHERCHEV par VBA ne résout pas le problème posé au post #1. "

Oui , je n'ai pas utilisez les tableaux ou les dictionnaires, mais il y a quand même une grosse différence avec la demande initiale. Chez moi, avec plus de 10000 lignes cela tourne autour d' 1 seconde, je sais aussi qu'avec l'emploi des dictionnaires on va tomber à quelques millisecondes, mais bon, comme Strick-TD ne se manifeste pas!!!

Bonjour désolé j'étais occupé ce matin, je viens à l'instant d'utiliser votre seconde proposition, ça marche du tonnerre ce que vous me proposez j'ai juste rajouté une fonction sierreur à la rechercheV et ça fonctionne en moins de 1 seconde. Je ne sais pas comment vous remercier.
Est-ce qu'il serait possible de détailler un petit peu ce que vous avez fait pour que je puisse comprendre s'il vous plaît ?
Plus particulièrement dans la formule rechercheV je ne comprends pas comment le fait de faire "synthèseC3:C4" prend toute ma colonne C et D.
Merci énormément !!

Rouge · 12 Décembre 2020

je ne comprends pas comment le fait de faire "synthèseC3:C4" C3:C4 équivaut à colonne C et Colonne D.

Est-ce qu'il serait possible de détailler un petit peu ce que vous avez fait pour que je puisse comprendre s'il vous plaît
On écrit la formule en une seule fois sur toute la plage, avec Range(Cells(2, 18), Cells(DerLig, 18))
la plage allant de "R2:R et dernière ligne trouvée"

Strick-TD · 12 Décembre 2020

Rouge à dit:
je ne comprends pas comment le fait de faire "synthèseC3:C4" C3:C4 équivaut à colonne C et Colonne D.

Est-ce qu'il serait possible de détailler un petit peu ce que vous avez fait pour que je puisse comprendre s'il vous plaît
On écrit la formule en une seule fois sur toute la plage, avec Range(Cells(2, 18), Cells(DerLig, 18))
la plage allant de "R2:R et dernière ligne trouvée"

D'accord, merci encore pour votre aide en tout cas vous m'avez rendu un énorme service. Bon week-end.

Staple1600 · 12 Décembre 2020

Bonjour le fil

Confinement oblige, je me permets de proposer une variante syntaxique du code de Rouge

VB:

Sub Recherche_V3()
Dim DerLig&, rng As Range
deb = Timer
Application.ScreenUpdating = False
DerLig = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row
Set rng = ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18))
rng = "=VLOOKUP(RC[-1],'[DB Articles.xlsx]Synthèse'!C3:C4,2,0)": rng = rng.Value
MsgBox "Durée: " & Timer - deb
End Sub

Ça ne devrait être ni plus rapide, ni plus long à exécuter.
Mais c'est un chouia moins long à lire.

job75 · 12 Décembre 2020

Bonjour JM,

Oui ni plus rapide ni plus long à exécuter.

Et il faudrait qu'on m'explique pourquoi une entrée manuelle dans toute la plage prendrait plus de temps.

A+

Staple1600 · 12 Décembre 2020

Bonjour job75

Pour ma part, je me suis contenté de proposer une variante syntaxique qu'il est possible de faire.
Et parce qu'il n'y a pas grande nouvelle question à se mettre sous la dent aujourd'hui.

Strick-TD · 13 Décembre 2020

Staple1600 à dit:
Bonjour le fil

Confinement oblige, je me permets de proposer une variante syntaxique du code de Rouge

VB:

Sub Recherche_V3() Dim DerLig&, rng As Range deb = Timer Application.ScreenUpdating = False DerLig = Workbooks("Macro - Mise en forme .xlsm").Worksheets("Test").Range("Q" & Rows.Count).End(xlUp).Row Set rng = ThisWorkbook.Worksheets("Test").Range(Cells(2, 18), Cells(DerLig, 18)) rng = "=VLOOKUP(RC[-1],'[DB Articles.xlsx]Synthèse'!C3:C4,2,0)": rng = rng.Value MsgBox "Durée: " & Timer - deb End Sub

Ça ne devrait être ni plus rapide, ni plus long à exécuter.
Mais c'est un chouia moins long à lire.

Bonjour Merci pour cette petite amélioration

J'aurais une question si vous le permettez, je souhaite adapter cette formule pour une autre rechercheV totalement similaire où les données sont sur un autre classeur.
Mon problème dans ma formule si dessous et que je n'arrive pas (je ne comprends pas bien surtout) comment sélectionner mes données en colonnes "D:E" et non pas en "C: D" que vous écrivez dans la formule de cette façon VLOOKUP(RC[-1],'[DB Articles.xlsx]Synthèse'!C3:C4,2,0). J'avoue que je ne comprends pas la logique, je pensais qu'en écrivant Synthèse'!D3: D4 ça suffirait pour décaler ma plage . Si on pouvait m'aider s'il vous plaît
Bonne journée.

Ci-joint le code actuel

VB:

Sub RechercheV6()
Dim DerLig2 As Long
    'deb = Timer
    Application.ScreenUpdating = False
    DerLig2 = Workbooks("Macro - Mise en forme V2.xlsm").Worksheets("Test").Range("AC" & Rows.Count).End(xlUp).Row
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 30), Cells(DerLig2, 30)) = "=iferror(VLOOKUP(RC[-1],'[DB JIT.xlsx]Synthèse JIT'!D3:D4,2,0),0)"
    ThisWorkbook.Worksheets("Test").Range(Cells(2, 30), Cells(DerLig2, 30)).Value = ThisWorkbook.Worksheets("Test").Range(Cells(2, 30), Cells(DerLig2, 30)).Value
    'MsgBox "Durée: " & Timer - deb
End Sub

Staple1600 · 13 Décembre 2020

Bonjour le fil,

Strick-TD
Donc tu préfères les longues lignes de codes ou plus courtes.
Je remballe mon amélioration alors.

Strick-TD · 13 Décembre 2020

Staple1600 à dit:
Bonjour le fil,

Strick-TD
Donc tu préfères les longues lignes de codes ou plus courtes.
Je remballe mon amélioration alors.

Staple1600,

Non non votre amélioration me servira à l'avenir J'ai juste voulu terminer mon projet sur lequel je travaille rapidement et je n'ai donc pas pris le temps de mettre votre amélioration
Cependant, si vous aviez une réponse à ma question précédente je suis preneur

Strick-TD

XL 2010 Accélération de Vlookup VBA

Strick-TD

XLDnaute Nouveau

Rouge

Rouge

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Rouge

XLDnaute Impliqué

job75

XLDnaute Barbatruc

Rouge

XLDnaute Impliqué

Strick-TD

XLDnaute Nouveau

Rouge

XLDnaute Impliqué

Strick-TD

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Strick-TD

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Strick-TD

XLDnaute Nouveau

Discussions similaires