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

Staple1600 · 13 Décembre 2020

Re

Est-ce que l'exemple ci-dessous éclaire ta lanterne?

VB:

Sub test()
Dim rng As Range, DerLig2&
DerLig2 = 5
Set rng = ThisWorkbook.Worksheets("Test").Range(Cells(2, 30), Cells(DerLig2, 30))
MsgBox rng.Address ' pour test
'rng.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],'Synthèse JIT'!R1C3:R4C4,2,0),0)"
rng.FormulaLocal = "=SIERREUR(RECHERCHEV(AC2;'Synthèse JIT'!$C$1:$D$4;2;0);0)"
End Sub

NB: J'ai renommé une feuille Synthèse JIT sur le même classeur qui contient une feuille test.
(pour la commodité de mon test)

Strick-TD · 13 Décembre 2020

Staple1600 à dit:
Re

Est-ce que l'exemple ci-dessous éclaire ta lanterne?

VB:

Sub test() Dim rng As Range, DerLig2& DerLig2 = 5 Set rng = ThisWorkbook.Worksheets("Test").Range(Cells(2, 30), Cells(DerLig2, 30)) MsgBox rng.Address ' pour test 'rng.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],'Synthèse JIT'!R1C3:R4C4,2,0),0)" rng.FormulaLocal = "=SIERREUR(RECHERCHEV(AC2;'Synthèse JIT'!$C$1:$D$4;2;0);0)" End Sub

NB: J'ai renommé une feuille Synthèse JIT sur le même classeur qui contient une feuille test.
(pour la commodité de mon test)

Re,

Ok je viens de comprendre j'avoue que ma question était très bête... Je ne savais pas qu'il y avait des raccourcis Rows Columns sur VBA (je débute). Merci pour ton aide bonne fin de week-end

Strick-TD

Staple1600 · 13 Décembre 2020

Re

Comme je ne suis pas sur que ma lanterne éclaire bien
(Et comme mes patates cuisent encore, et qu'il faut s'occuper pendant qu'on confine)
Ci-dessous de quoi faire un petit test
Sur un classeur vierge: deux feuilles
L'une nommée: Test
L'autre nommée: Synthèse JIT
Lancer d'abord la macro Petit_Test
(Elle ne sert qu'a créer l'exemple)
Puis lancer la macro Pour_Tester_Le_Petit_Test

VB:

Sub Petit_Test()
Dim f As Worksheet
Set f = Sheets("Synthèse JIT")
form = Array("=ADDRESS(ROW(),COLUMN(),4)", _
            "=INDEX({""chat"";""maison"";""arbre"";""ciel""},RANDBETWEEN(1,4),0)&""_""&TEXT(ROW(),""000"")")
f.[C1:D1] = form: f.[C1:D4].FillDown: f.[C1:D4] = f.[C1:D4].Value
End Sub
Sub Pour_Tester_Le_Petit_Test()
Randomize
Sheets("Test").Select
Range("AD2:AD5").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],'Synthèse JIT'!R1C3:R4C4,2,0),0)"
Application.Goto [AC2], True
x = InputBox("Saisir un chiffre de 1 à 4", "Test", Application.RandBetween(1, 4))
ActiveCell = "C" & x
End Sub

Regardez ensuite les formules sur la feuille Test en AD2:AD5

XL 2010 Accélération de Vlookup VBA

Strick-TD

XLDnaute Nouveau

Rouge

Staple1600

XLDnaute Barbatruc

Strick-TD

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires