VBA Optimisation et gain de temps Application.vlookup

Bonjour et bonne année à tous!! :)

Je reviens vers vous après quelques jours passé sur mon code.

Lequel fonctionne mais son exécution est très (trop) longue (environ 2h et encore...:?)


Mon classeur contient 3 onglets,

J'ai un onglet ou je souhaite récupérer des valeurs des deux autres onglets.

Je n'ai pour l'instant pas trouvé d'autre code que WorksheetFunction.VLookup.

Je souhaiterai une optimisation du code ou autre proposition dont l'éxécution serait plus rapide svp

Si vous pouviez y jeter un petit oeil :)


voici le code :

Code:

---

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

Sub BaseOPE_1() Dim i As Long, ligfin As Variant, ligfin2 As Variant, ligfin3 As Variant   Application.ScreenUpdating = False   ligfin = Sheets("BaseOPE").Cells(Rows.Count, 1).End(xlUp).Row ligfin2 = Sheets("listeOT").Cells(Rows.Count, 1).End(xlUp).Row ligfin3 = Sheets("ZPMQ").Cells(Rows.Count, 1).End(xlUp).Row   For i = 2 To ligfin       On Error Resume Next   If Worksheets("BaseOPE").Cells(i, 2) = "" Then Worksheets("BaseOPE").Cells(i, 2).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 1), Worksheets("listeOT").Range("A2:C" & ligfin2), 2, "false") If Worksheets("BaseOPE").Cells(i, 19) = "" Then Worksheets("BaseOPE").Cells(i, 19).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 1), Worksheets("listeOT").Range("A2:D" & ligfin2), 3, "false")     If Worksheets("BaseOPE").Cells(i, 9) = "" Then Worksheets("BaseOPE").Cells(i, 9).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:C" & ligfin3), 3, "false") If Worksheets("BaseOPE").Cells(i, 10) = "" Then Worksheets("BaseOPE").Cells(i, 10).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:D" & ligfin3), 4, "false") If Worksheets("BaseOPE").Cells(i, 11) = "" Then Worksheets("BaseOPE").Cells(i, 11).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:E" & ligfin3), 5, "false") If Worksheets("BaseOPE").Cells(i, 12) = "" Then Worksheets("BaseOPE").Cells(i, 12).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:F" & ligfin3), 6, "false") If Worksheets("BaseOPE").Cells(i, 13) = "" Then Worksheets("BaseOPE").Cells(i, 13).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:G" & ligfin3), 7, "false") If Worksheets("BaseOPE").Cells(i, 16) = "" Then Worksheets("BaseOPE").Cells(i, 16).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 8), Worksheets("ZPMQ").Range("B2:J" & ligfin3), 9, "false") If Worksheets("BaseOPE").Cells(i, 21) = "" Then Worksheets("BaseOPE").Cells(i, 21).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:K" & ligfin3), 11, "false") If Worksheets("BaseOPE").Cells(i, 21) = "" Then Worksheets("BaseOPE").Cells(i, 21).Value = WorksheetFunction.VLookup(Worksheets("BaseOPE").Cells(i, 7), Worksheets("ZPMQ").Range("A2:L" & ligfin3), 12, "false")     If Error <> 0 Then Values = 0 If Error <> 0 Then Values = xlErrNA       Next i Application.ScreenUpdating = True End Sub

---

Un grand merci!

Bonjour jeremy75018,

Si j'ai bien compris ce que tu souhaites faire, essaye la fonction "Find".
Voici un exemple pour ton premier VLookup :

Code:

---

1 2 3

If Worksheets("BaseOPE").Cells(i, 2) = "" Then Worksheets("BaseOPE").Cells(i, 2) = Worksheets("listeOT").Columns(1).Find(Worksheets("BaseOPE").Cells(i, 2), LookIn:=xlValues, LookAt:=xlWhole).Offset(, 2) End If

---

Ne pouvant pas trop tester, j'espère que c'est fonctionnel ! :aie:

N'hésite pas à revenir vers moi ! :ccool:

Cordialement,
Kimy

EDIT : de plus, tu peux rajouter ceci en début de macro

Code:

---

1 2	Application.Visible = False Application.Calculation = xlCalculationManual

---

... et forcément ceci en fin :

Code:

---

1 2	Application.Calculation = xlCalculationAutomatic Application.Visible = True

---

Bonjour, bonjour !

Réponse déjà donnée jeremy dans ta discussion de décembre dernier, déjà oublié ?‼‼ 8O

Ne pas utiliser de boucle mais une formule globale sur la plage !


__________________________________________________________________________________________________
Tous unis, tous Charlie

Bonsoir Kimy,

Tout d'abord merci d'avoir pris du temps pour mon pb :)

Le code proposé ne me ramène aucune valeur même après ajout des lignes :?

Code:

---

1 2	Application.Visible = False Application.Calculation = xlCalculationManual

---

Code:

---

1 2	Application.Calculation = xlCalculationAutomatic Application.Visible = True

---

Encore merci de prendre du temps pour moi :)

Bien cordialement

Bonsoir Marc L ,

Bien content de te retrouver :)

Le problème en ne mettant pas de boucle mais une formule globale sur la plage il y plantage (Fichier ne répond plus...:?)
après quelques recherches sur la toile j'ai trouvé ce code que j'ai ensuite adapté ....mais l'éxécution de celui-ci est trop long.

Mais je suis preneur de solutions plus simples ou plus efficaces ;)

Encore Merci!

Bonjour,

Une fonction perso matricielle + rapide que Recherchev()

http://boisgontierjacques.free.fr/pa...FonctionRechVM

Jacques Boisgontier