XL 2013 [RESOLU] VBA: optimisation code Boucle

sarah33

XLDnaute Junior
Bonjour le fofo,

Je suis en train de faire une petite appli Excel qui consiste à importer des données de plusieurs autres feuilles excel, provenant d'une extraction d'un ERP. Les informations sont compilées sur deux feuilles de ~70 000lignes

Dans un second temps, je traite ces données via une boucle qui traite chaque ligne:
- Calculs entre les lignes (IF Cells)
- Recherche dans d'autres Feuilles (VLookup)
- Qui comprend une autre petite boucle "a" à l'intérieur de la boucle principal (i)

C'est pour cette seconde partie que j'ai besoin de votre expertise. En effet, le code que j'ai réalisé fonctionne..mais il est lent environ 40s de traitement avec une machine de compétition...

Je débute le VBA, je bouffe du tuto mais j'ai pas encore les bonnes pratiques...
Merci d'avance si vous pouvez jeter un coup d'oeil, et me conseiller pour améliorer la qualité de mon code.

a+

Code:
Sub Traitement_Imp_Ventes()
Dim derli As String, nbvent As String
Dim R As Variant, S As Variant
nbvent = Sheets("Références").Range("L1").End(xlDown).Row
derli = Sheets("Ventes").Range("K1").End(xlDown).Row

For i = 2 To derli

'Remplacer les vides par dates par ligne
If Cells(i, 2) = "" And Cells(i, 10) <> "" Then
Cells(i, 2) = Cells(i - 1, 2)
End If
'Remplacer les vides par N°commande par ligne
If Cells(i, 3) = "" And Cells(i, 10) <> "" Then
Cells(i, 3) = Cells(i - 1, 3)
End If

'Remplacer les Vides par zéro  Prix Achats
If IsEmpty(Cells(i, 4)) Then
Cells(i, 4).Value = 0
End If


'Remplacer les Vides par zéro Prix Public
If IsEmpty(Cells(i, 5)) Then
Cells(i, 5).Value = 0
End If

'Remplacer les Vides par zéro Prix Vente
If IsEmpty(Cells(i, 6)) Then
Cells(i, 6).Value = 0
End If


'Remplacer les vides par Clients par ligne
If Cells(i, 8) = "" And Cells(i, 10) <> "" Then
Cells(i, 8) = Cells(i - 1, 8)
End If

'Remplacer les vides par Statut par ligne
If Cells(i, 9) = "" And Cells(i, 10) <> "" Then
Cells(i, 9) = Cells(i - 1, 9)
End If
'Calcul Total vendu
Cells(i, 12) = Cells(i, 7) * Cells(i, 6)
'Ref Interne démentellée
Cells(i, 13).Value = Replace(Replace(Left(Cells(i, 10), InStr(Cells(i, 10), "]")), "[", ""), "]", "")
'N°semaine
Cells(i, 14) = NoSemaineISO(Cells(i, 2))

'Déterminer les type de vente à classer comme Interne

For a = 2 To nbvent
If Sheets("Ventes").Cells(i, 8) = Sheets("Références").Cells(a, 12) Then
Sheets("Ventes").Cells(i, 15) = "Interne"
End If
Next a
'Détermine les types de ventes à classer en externe
If IsEmpty(Cells(i, 15)) Then
Cells(i, 15) = "Externe"
End If

'Calcul Taux Réduction
If Cells(i, 6) > 0 And Cells(i, 5) Then
Cells(i, 16) = 1 - (Cells(i, 6) / Cells(i, 5))
'Calcul Réduction
Cells(i, 17) = (Cells(i, 5) - Cells(i, 6)) * Cells(i, 7)
Else
Cells(i, 16) = 0
Cells(i, 17) = 0
End If

'Calcul Marge
Cells(i, 18) = Cells(i, 12) - (Cells(i, 4) * Cells(i, 7))
'Calcul Taux MArge
If Cells(i, 18) > 0 Then
Cells(i, 19) = Cells(i, 18) / Cells(i, 12)
End If


'Recherche dans une autre feuille les Marques
R = Application.VLookup(Cells(i, 13), Sheets("Article Table").Range("D:E"), 2, False)
If IsError(R) Then
Cells(i, 20) = ""
Else
Cells(i, 20) = R
End If


'Recherche dans une autre feuille les groupes ref
S = Application.VLookup(Cells(i, 13), Sheets("Article Table").Range("D:AN"), 36, False)
If IsError(S) Then
Cells(i, 21) = ""
Else
Cells(i, 21) = S
End If
'Détermine Type de vente
If Left(Cells(i, 13), 2) = "PS" Then
Cells(i, 22) = "Main d'oeuvre"
ElseIf Cells(i, 13) = "AVPURA" Then
Cells(i, 22) = "Taxe"
Else
Cells(i, 22) = "Pièce"
End If

Next i


'Renommer entêtes
Cells(1, 2) = "Date"
Cells(1, 3) = "N°Commande"
Cells(1, 4) = "PU Achat"
Cells(1, 5) = "PU Public"
Cells(1, 6) = "PU Vente"
Cells(1, 7) = "Qtité"
Cells(1, 8) = "Client"
Cells(1, 9) = "Etat"
Cells(1, 10) = "Designation"
Cells(1, 12) = "Total vendu"
Cells(1, 13) = "Ref interne"
Cells(1, 14) = "Semaine"
Cells(1, 15) = "Vente"
Cells(1, 16) = "Taux Réduction"
Cells(1, 17) = "Réduction"
Cells(1, 18) = "Marge"
Cells(1, 19) = "Taux Marge"
Cells(1, 20) = "Marque"
Cells(1, 21) = "Ref Groupe"
Cells(1, 22) = "Type de vente"
Cells(1, 23) = "Catégorie"
End Sub
 
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

Bonjour sarah33,

On pourrait commencer par se dire que 40 secondes, pour pareil traitement, ce n'est pas "cher payé" et qu'en fin de compte, on peut laisser les choses en l'état :)

Il y a sans doute des manipulations qui pourraient se faire en dehors d'une boucle (remplacer les cellules vides d'une colonne par des zéros, si j'ai bien compris!?)

Si tu "bouffes du tuto", une saine lecture serait certainement tout ce qui concerne les "tableaux en mémoire". Y copier l'ensemble des données à traiter permettrait de diminuer le temps dudit traitement, de manière plus que significative. Il y a plein d'exemples dans des discussions ici même.

Enfin, nous montrer ton code c'est bien, mais un fichier exemple permettrait:
  1. de tester toute proposition
  2. de mieux comprendre certaines parties de ton code (ta petite boucle sur a, notamment :confused: ... de ce que je crois comprendre, l'équivalent d'un NB.SI ferait la même chose ... ou alors me gourre-je quand je cucurbite assez :eek:)
 

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

Hello Modeste,

Merci pour ta réponse, et d'avoir pris le temps de regarder mon code.
Enfaite, j'ai mis un compteur, et je suis pas à 40s, mais à 2min40s.

Concernant le remplacement des cellules vides par zéro: j'avais pensais à l'équivalent VBA de Ctrl+F /Remplacer ? c'est moins long?

Pour les autres remplacement de cellules vides, enfaite le fichier d'import ne reprends pas systématiquement toutes les infos pour chaque ligne (ex: pour les commandes, certains infos sont inscrites que sur la première ligne, et les autres lignes de cette même commande sont vide), c'est pourquoi lors de la seconde phase "Traitement des données" je vérifie que la ligne existe, et si c'est le cas et que la cellule qui devrait être remplie est vide, je reprend la valeur de la cellule de la ligne du dessus.

La boucle (a), vérifie si la cellule (i, 8) est égalet à une des cellules d'une plage sur une autre feuille.
En gros, Cells(1, 8) est le client. Si le client appartient à une liste de client(d'environ 8 clients), alors il est classé comme "Interne" (car la vente s'effectue auprès d'une agence de la même entreprise).

Concernant les tableaux en mémoire, je vais me renseigner à ce sujet, je te remercie pour cette piste.
Quant aux déclarations en début de code, pensez-vous qu'il n'y ait pas une perte de vitesse à ce niveau?

Par rapport, au boucle, en règle général.
Dans mon exemple, je boucle chaque ligne, pour appliquer des fonctions à chaque colonne de chaque ligne.

Ne vaudrait-il pas mieux boucler colonne par colonne?

Mes deux fonctions en Vlookup sont grandement fautifs du temps de chargement, est-ce qu'il ne vaudrait-il pas mieux les isoler dans une autre boucle?

Pour le fichier, c'est des infos critiques, prix, nom de client, nom de marque.. etc.. et 75000lignes ... le refaire me prendrai bcp bcp de temps, je vois pas trop comment faire...pour le mettre en ligne.

Merci =)
 
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

Re,

On est bien d'accord qu'il ne saurait être question de mettre en ligne un fichier de 75000 lignes, bourré d'info confidentielles ... tu ne peux pas copier une centaines de lignes, y remplacer le nom des clients et/ou des produits, par des noms "bidons", conserver quelques infos dans tes feuilles "Références" et "Article table" (en les anonymisant aussi) et déposer cette version "expurgée"?
 

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

Voilà le fichier exemple, une bonne heure pour le faire !

Il faut lancer la macro: Traitement_Imp_Ventes
Si le traitement parait rapide comme ça , il ne l'est pas haha :eek: sur mon fichier original (>2min40)
Je vais probablement mon rediriger vers les tableaux en mémoire comme conseillé. Dès lors que j'aurai compris comment ça marche.... déjà faut il qu'il soit libre ou figé?

Merci d'avance pour vos retours.
 

Pièces jointes

  • Exemple ouf.xlsm
    35.7 KB · Affichages: 80
  • Exemple ouf.xlsm
    35.7 KB · Affichages: 79
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

Re-bonjour sarah,
Bonjour DL_13,

Je n'ai pas réécrit tout le code: je ne me suis pas occupé des VLookUp, notamment. Vois déjà si tu t'y retrouves!
J'ai conservé le même type de manipulations que celles que tu faisais, sauf pour la partie avec ta boucle sur 'a'.

À première vue et pour la partie traitée, les résultats semblent identiques ... à vérifier.
Avant d'aller plus loin, il faudrait tester sur des "portions" de fichier plus importantes (sans attaquer les 70.000 lignes d'emblée), pour vérifier si le gain de temps se confirme ... et si je n'ai pas fait d'erreur(s) :confused:
VB:
Sub Traitement_Imp_Ventes()
'Dim derli As String, nbvent As String
Dim R As Variant, S As Variant
nbvent = Sheets("Références").Range("L1").End(xlDown).Row
derli = Sheets("Ventes").Range("K1").End(xlDown).Row

'on copie toute la plage dans un tableau
tablo = Sheets("Ventes").[A2].Resize(derli - 1, 23)
For i = 1 To UBound(tablo)
 
'Remplacer les vides par dates par ligne
If tablo(i, 2) = "" And tablo(i, 10) <> "" Then tablo(i, 2) = tablo(i - 1, 2)
'Remplacer les vides par N°commande par ligne
If tablo(i, 3) = "" And tablo(i, 10) <> "" Then tablo(i, 3) = tablo(i - 1, 3)

'Remplacer les Vides par zéro  Prix Achats
If IsEmpty(tablo(i, 4)) Then tablo(i, 4) = 0

'Remplacer les Vides par zéro Prix Public
If IsEmpty(tablo(i, 5)) Then tablo(i, 5) = 0

'Remplacer les Vides par zéro Prix Vente
If IsEmpty(tablo(i, 6)) Then tablo(i, 6) = 0

'Remplacer les vides par Clients par ligne
If tablo(i, 8) = "" And tablo(i, 10) <> "" Then tablo(i, 8) = tablo(i - 1, 8)

'Remplacer les vides par Statut par ligne
If tablo(i, 9) = "" And tablo(i, 10) <> "" Then tablo(i, 9) = tablo(i - 1, 9)

'Calcul Total vendu
tablo(i, 12) = tablo(i, 7) * tablo(i, 6)
'Ref Interne démentellée
tablo(i, 13) = Replace(Replace(Left(tablo(i, 10), InStr(tablo(i, 10), "]")), "[", ""), "]", "")
'N°semaine
tablo(i, 14) = NoSemaineISO(CDate(tablo(i, 2)))

'Supp vente interne
'For a = 2 To nbvent
'If Sheets("Ventes").Cells(i, 8) = Sheets("Références").Cells(a, 12) Then
'Sheets("Ventes").Cells(i, 15) = "Interne"
'End If
'Next a
'If IsEmpty(Cells(i, 15)) Then
'Cells(i, 15) = "Externe"
'End If
'**** la ligne suivante remplace les 8 lignes en commentaire ci-dessus
tablo(i, 15) = IIf(Application.CountIf(Sheets("Références").[L2].Resize(nbvent - 1, 1), tablo(i, 8)), "Interne", "Externe")

'Calcul Taux Réduction
If tablo(i, 6) > 0 And tablo(i, 5) Then
tablo(i, 16) = 1 - (tablo(i, 6) / tablo(i, 5))
'Calcul Réduction
tablo(i, 17) = (tablo(i, 5) - tablo(i, 6)) * tablo(i, 7)
Else
tablo(i, 16) = 0
tablo(i, 17) = 0
End If

Next i
'colle dans la feuille le contenu du tableau mis à jour
Sheets("Ventes").[A2].Resize(derli - 1, 23) = tablo

End Sub
 

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

Bonjour DL_13,
Re Modeste,

Waouh tout d'abord merci pour le temps consacré..
Je viens de test en grandeur nature ton code, sans donc la partie VlookUp ni le nommage des entêtes.
C'est impressionnant le gain de traitement, on est à une vingtaine de seconde !!!
Cependant, la Vlookup était la plus consommatrice je pense.

Je vais mettre un fichier en ligne avec plus de données, et si j'y arrive, y intégrer un compteur pour mesurer le temps de chargement.

Concernant les Tableaux en mémoire.
Si j'ai bien compris,
Pas besoin de le déclarer
Il commence à 0 et pas à 1


Je travail le nouveau fichier test et le remet en ligne.

Encore merci pour cette précieuse aide !
 
Dernière édition:

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

1min40 avec les "tablo" contre 2min40 en direct sur la feuille.

sans les VlookUP je suis à 20s, soit 80s pour les deux codes ci-dessous:


Code:
'Recherche Marque
R = Application.VLookup(tablo(i, 13), Sheets("Article Table").Range("D:E"), 2, False)
If IsError(R) Then
tablo(i, 20) = ""
Else
tablo(i, 20) = R
End If

'Recherche dans une autre feuille les groupes ref
S = Application.VLookup(tablo(i, 13), Sheets("Article Table").Range("D:AN"), 36, False)
If IsError(S) Then
tablo(i, 21) = ""
Else
tablo(i, 21) = S
End If
'Détermine Type de vente
If Left(tablo(i, 13), 2) = "PS" Then
tablo(i, 22) = "Main d'oeuvre"
ElseIf tablo(i, 13) = "AVPURA" Then
tablo(i, 22) = "Taxe"
Else
tablo(i, 22) = "Pièce"
End If
 

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

Question pour Vlookup, est ce que je peux remplacer "Sheets("Article Table").Range("D:AN") par un autre tableau en mémoire?
Code:
tablo = Sheets("Ventes").[A2].Resize(derli - 1, 23)
Autre question, tu n'as pas repris les entêtes dans le tableau en mémoire, y a t il une raison particulière?
pour le renommage des entetes je dois donc le faire en Cells(x,x) ?

Perso, je l'aurai fait partir en A1, et le (i) commencer à 2 au lieu de 1.. mais j'ose plus ducoup :eek:
 
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

Question pour Vlookup, est ce que je peux remplacer "Sheets("Article Table").Range("D:AN") par un autre tableau en mémoire?
Je crains que pour la recherche, ça ne change rien! Et tu ne pourras pas faire un VLookUp sur un Array (en tout cas, je ne crois pas). Encore une fois, avec tous les traitements à faire, je ne suis pas certain que tu puisses encore gagner du temps ... en tout cas pas 10 min ;)
Il y a peut-être encore moyen de grappiller des secondes, mais je n'en suis pas certain (et il faudrait pouvoir tester les différentes solutions sur un gros volume).

Pour ce qui est des en-têtes, je ne les avais pas reprises dans le code ... parce que ce que tu avais écrit devait fonctionner. Tu peux recopier les lignes que tu avais écrites précédemment, après la recopie du tableau dans la feuille. Attention, il semble manquer le titre en colonne 11 !?
Tu peux aussi écrire;
VB:
'Renommer entêtes
tabloTitres = Array("Date", "N°Commande", "PU Achat", "PU Public", "PU Vente", "Qtité", "Client", "Etat", "Designation", "Entité", "Total vendu", "Ref interne", "Semaine", "Vente", "Taux Réduction", "Réduction", "Marge", "Taux Marge", "Marque", "Ref Groupe", "Type de vente", "Catégorie")
Sheets("Ventes").Cells(1, 2).Resize(1, 22) = tabloTitres
... mais je précise: ça ne te fera pas gagner 1 minute 10 :rolleyes:
 

laetitia90

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

bonjour sarah ,Modeste:):)

comme je comprends:rolleyes::rolleyes: pas sur......... ne maitrisant pas Application.VLookup
ces sequences de codes on pourrez passer par un dico liaisons tardives ou pas a voir???



< a 1 SECONDE sur 75000 items

mais bon !!! pas mon pc avec excel avant fin de semaine .....une piste :p:p

mon NEW 6700K pas aime overclook a 5 GHZ:(:(:(
 

sarah33

XLDnaute Junior
Re : VBA: optimisation code Boucle beaucoup de ligne

Salut laetitia,
je vais bientot mettre en ligne un fichier exemple plus conséquent, plus réaliste avec des recherches plus costauds ;)

Modeste, merci beaucoup pour cette méthode de tableau !!

Par rapport au problème de recherche , je viens de tomber sur un article intéressant :
https://www.excel-downloads.com/thr...bleaux-trouver-une-valeur-sans-boucle.181735/

dans lequel la Recherche Dictionnary semble la méthode la plus rapide, et le Vlookup la plus lente, pensez vous que ça puisse se combiner à mon code? est cela dont tu parles laetitia?

Merci !
 
Dernière édition:

Modeste

XLDnaute Barbatruc
Re : VBA: optimisation code Boucle beaucoup de ligne

'soir :)
Salut leti :D:D:D

Avant de lire laetitia et d'aller courir, j'étais parti sur une autre idée.
Ces lignes remplaceraient les 2 Vlookup (si j'ai bien compris?)
VB:
'Recherche dans une autre feuille les Marques
numLigne = Application.Match(tablo(i, 13), Sheets("Article Table").Range("D1:D1000"), 0)
If IsNumeric(numLigne) Then
    tablo(i, 20) = Sheets("Article Table").Cells(numLigne, 5) 'Recherche les Marques
    tablo(i, 21) = Sheets("Article Table").Cells(numLigne, 39) 'Recherche les groupes ref
End If

... Si Sarah pouvait tester ...

Si la préparation (puis la consommation) du dîner le permettent, je viendrai voir ce qu'il en est du Dictionary.
Je connaissais le Gewürztraminer vendanges tardives, mais pas le Dico liaisons tardives :D
 

Discussions similaires

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi