Microsoft 365 Accelerer l'execution du code

Faroyo

XLDnaute Junior
Bonjour,
plutot debutant en vba, je cheche un moyen d'accelerer l'execution de mon code.
J'ai une boucle index match combinée avec un 2 vlookup. Tout fonctionne tres bien mais il peut prendre pas mal de temps.
La recheche s'effectue dans une base de pouvant contenir 100000 lignes d'ou le pb, enfin je pense.
Merci pour votre aide.

Faroyo


VB:
 Sub Newold()

Dim lastline As Integer

Dim ws1 As Worksheet: Set ws1 = Sheets("MARC_POSTLOAD_1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Conversion New - Old")
Dim vBase, C As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

lastline = ws1.Range("A:A").End(xlDown).Row

   ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Application.WorksheetFunction

If ws2.Range("A2") <> "" Then

    For x = 2 To lastline
    
        Range("B" & x).Value = (Application.Index(ws1.Range("A:B"), Application.Match(ws2.Range("A" & x), ws1.Range("B:B"), 0), 1))
        If IsError(Range("B" & x).Value) Then
        Range("B" & x).Value = ""
        End If
        Range("C" & x).Value = Application.WorksheetFunction.IfError(Application.VLookup(Range("A" & x).Value, ws1.Range("B:H"), 4, 0), "") 'Description
        Range("D" & x).Value = Application.WorksheetFunction.IfError(Application.VLookup(Range("A" & x).Value, ws1.Range("B:H"), 7, 0), "") 'Description

  Next
 
  End If
    
    End With

 format
 
End Sub
 
Solution
Bonjour Faroyo, Efgé,
Une possibilité, plutôt qu'on long for next, est de mettre les formules dans la feuille puis de faire un copier coller des valeurs.
Sur mon PC on passe de 22s à 5s. Avec pour les formules dans Newold :
VB:
If ws2.Range("A2") <> "" Then
    Range("B2:B" & lastline) = _
        "=IFERROR(INDEX(data!C[-1]:C,MATCH(RC[-1],data!C,0),1),"""")"   'B2 : =SIERREUR(INDEX(data!A:B;EQUIV(A2;data!B:B;0);1);"")
    Range("C2:C" & lastline) = _
        "=IfError(VLookup(RC[-2], data!C[-1]:C[5], 4, false), """")"    'C2 : =SIERREUR(RECHERCHEV(A2; data!B:H; 4; FAUX); "")
    Range("D2:D" & lastline) = _
        "=IFERROR(VLOOKUP(RC[-3],data!C[-3]:C[4],7,FALSE),"""")"        'D2 : =SIERREUR(RECHERCHEV(A2;data!A:H;7;FAUX);"")...

Efgé

XLDnaute Barbatruc
Bonjour @Faroyo , Salut @sylvanu
Je plussois à la demande de sylvanu, la question est pour le moins surprenante:
Dim lastline As Integer
Alors que:
base de pouvant contenir 100000 lignes

J'attend l'exemple avec impatience ;)

D'autre part, une première remarque :
Si Application.ScreenUpdating = False n'a pas forcément besoin d'un Application.ScreenUpdating = True, il n'en vas pas de même pour Application.EnableEvents
Cordialement
 

Faroyo

XLDnaute Junior
Toutes mes exceuses pour ce contre temps. Gros pb de connexion suite a l'installation de la fibre.
Le pb semble résolut à présent, pour le réseau mais pas pour mon fichier.
Merci pour la remarque concernant Application.EnableEvents
Je vous joins le fichier. J'ai reduit le fichier à 10000 lignes afin de pouvoir le déposer.
Mon soucis de lenteur est avec l'onglet "Conversion New - Old". Il s'agit là, de convertir les valeurs en bleu dans l'onglet "data" pour retrouver les valeurs en vert du meme onglet. Menme avec que 10000 lignes la recherche est tres lente. Avec la totalité dess donnees c'est juste pas possible.

Merci pour votre aide
 

Pièces jointes

  • Conversion.xlsm
    831 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Faroyo, Efgé,
Une possibilité, plutôt qu'on long for next, est de mettre les formules dans la feuille puis de faire un copier coller des valeurs.
Sur mon PC on passe de 22s à 5s. Avec pour les formules dans Newold :
VB:
If ws2.Range("A2") <> "" Then
    Range("B2:B" & lastline) = _
        "=IFERROR(INDEX(data!C[-1]:C,MATCH(RC[-1],data!C,0),1),"""")"   'B2 : =SIERREUR(INDEX(data!A:B;EQUIV(A2;data!B:B;0);1);"")
    Range("C2:C" & lastline) = _
        "=IfError(VLookup(RC[-2], data!C[-1]:C[5], 4, false), """")"    'C2 : =SIERREUR(RECHERCHEV(A2; data!B:H; 4; FAUX); "")
    Range("D2:D" & lastline) = _
        "=IFERROR(VLOOKUP(RC[-3],data!C[-3]:C[4],7,FALSE),"""")"        'D2 : =SIERREUR(RECHERCHEV(A2;data!A:H;7;FAUX);"")
    Range("B2:DZ" & lastline) = Range("B2:DZ" & lastline).Value         ' Copier Coller valeurs
End If
J'ai rappelé en commentaires les formules utilisées au cas où elles seraient erronées pour pouvoir rectifier.
 

Pièces jointes

  • Conversion2.xlsm
    853 KB · Affichages: 5

Faroyo

XLDnaute Junior
Bonjour Faroyo, Efgé,
Une possibilité, plutôt qu'on long for next, est de mettre les formules dans la feuille puis de faire un copier coller.
Sur mon PC on passe de 22s à 5s. Avec pour les formules dans Newold :
VB:
If ws2.Range("A2") <> "" Then
    Range("B2:B" & lastline) = _
        "=IFERROR(INDEX(data!C[-1]:C,MATCH(RC[-1],data!C,0),1),"""")"   'B2 : =SIERREUR(INDEX(data!A:B;EQUIV(A2;data!B:B;0);1);"")
    Range("C2:C" & lastline) = _
        "=IfError(VLookup(RC[-2], data!C[-1]:C[5], 4, false), """")"    'C2 : =SIERREUR(RECHERCHEV(A2; data!B:H; 4; FAUX); "")
    Range("D2:D" & lastline) = _
        "=IFERROR(VLOOKUP(RC[-3],data!C[-3]:C[4],7,FALSE),"""")"        'D2 : =SIERREUR(RECHERCHEV(A2;data!A:H;7;FAUX);"")
    Range("B2:DZ" & lastline) = Range("B2:DZ" & lastline).Value         ' Copier Coller valeurs
End If
J'ai rappelé en commentaires les formules utilisées au cas où elles seraient erronées pour pouvoir rectifier.
Merci
je vais de ce pas tester cette solution
 

Faroyo

XLDnaute Junior
Merci
je vais de ce pas tester cette solution

Bonjour Faroyo, Efgé,
Une possibilité, plutôt qu'on long for next, est de mettre les formules dans la feuille puis de faire un copier coller des valeurs.
Sur mon PC on passe de 22s à 5s. Avec pour les formules dans Newold :
VB:
If ws2.Range("A2") <> "" Then
    Range("B2:B" & lastline) = _
        "=IFERROR(INDEX(data!C[-1]:C,MATCH(RC[-1],data!C,0),1),"""")"   'B2 : =SIERREUR(INDEX(data!A:B;EQUIV(A2;data!B:B;0);1);"")
    Range("C2:C" & lastline) = _
        "=IfError(VLookup(RC[-2], data!C[-1]:C[5], 4, false), """")"    'C2 : =SIERREUR(RECHERCHEV(A2; data!B:H; 4; FAUX); "")
    Range("D2:D" & lastline) = _
        "=IFERROR(VLOOKUP(RC[-3],data!C[-3]:C[4],7,FALSE),"""")"        'D2 : =SIERREUR(RECHERCHEV(A2;data!A:H;7;FAUX);"")
    Range("B2:DZ" & lastline) = Range("B2:DZ" & lastline).Value         ' Copier Coller valeurs
End If
J'ai rappelé en commentaires les formules utilisées au cas où elles seraient erronées pour pouvoir rectifier.
Toutes mes excuses Sylvanu,,
je viens de me rendre compte que de je remerciais la mauvaise personne. J'ai un peu honte.
Je suis désolé.
Alors, mille merci Sylvanu
 

eriiic

XLDnaute Barbatruc
Bonjour,

il y avait en plus une erreur de conception dans ton code.
VB:
lastline = ws1.Range("A:A").End(xlDown).Row
If ws2.Range("A2") <> "" Then
    For x = 2 To lastline
        Range("B" & x).Value = (Application.Index(ws1.Range("A:B"), Application.Match(ws2.Range("A" & x), ws1.Range("B:B"), 0), 1))
tu regardes le nombre de lignes de data pour écrire celles Conversion.
Ca t'en fait 10000 même si tu ne convertis que 2 ref.

D'autre part tu fais un Recherchev() sur data!$B$1:$H$10901.
Hors la colonne B n'est pas triée ce qui est obligatoire, si je ne m'abuse, pour une recherche exacte avec ;FAUX) ou ;0) comme tu as écrit
eric
 
Dernière édition:

eriiic

XLDnaute Barbatruc
Tu veux balayer les ligne de ws2 (tes saisies à rechercher, et tu comptes le nombre de lignes de ws1
Résultat, si tu as 2 recherches à faire, tu inscris tes formules sur 10000 lignes.
Forcément c'est plus long que nécessaire...

VB:
Dim ws1 As Worksheet: Set ws1 = Sheets("data") ' 10000 lignes
Dim ws2 As Worksheet: Set ws2 = Sheets("Conversion New - Old")

lastline = ws1.Range("A:A").End(xlDown).Row ' ws1 : 10000 lignes !!!!
If ws2.Range("A2") <> "" Then
    For x = 2 To lastline ' =to 10000
        Range("B" & x).Value = ' tu travailles sur la feuille active (ws2) qui n'a peut-être que 2 lignes à faire

C'est plus plus clair ?
Ce pb est sans aucun doute corrigé dans les propositions qui t'ont été faites.
C'était plus pour t'alerter d'être attentif à ce que tu écris, de tester au fur et à mesure, de contrôler tes valeurs de variables en pas à pas, bref d'apprendre à déboguer un minimum .
eric