Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Accelerer l'execution du code

F

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);"")...
Trier par date Trier par votes

Efgé

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

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
 
Vote positif 0 Vote négatif
F

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: 11
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif
Solution
F

Faroyo

XLDnaute Junior
Merci
je vais de ce pas tester cette solution
 
Vote positif 0 Vote négatif
F

Faroyo

XLDnaute Junior
Faroyo à dit:
Merci
je vais de ce pas tester cette solution
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif

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:
Vote positif 0 Vote négatif
F

Faroyo

XLDnaute Junior
Bonjour Eriiic,
très pertinente ta remarque sur le tri. C'est parfaitement exacte.
Je vais corriger cela.
Par contre , je ne comprends pas trop ta remarque sur la conception. Il faut que tu m'en dises plus à présent.

Merci
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
398
Phil69970
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
679
sylvanu
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
528
AtTheOne
N
  • Résolu(e)
Microsoft 365 Calcul de plages horaires
2 3 4
Réponses
49
Affichages
1 K
NONO14
N
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
349
Gégé-45550
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
450
GClaire
G
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
1 K
Banbara
B
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
D
  • Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
893
AtTheOne
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…