Optimisation de partie de macro.

Hello world !

Je reviens vers vous après un petit silence respectable, afin de vous soumettre une question :

J'ai actuellement un bout de code :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Dim p0 As Long Dim p1 As Long p0 = 0 p1 = 2 For p0 = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1 If InStr(Cells(p0, 5).Value, "HA") = 1 Or InStr(Cells(p0, 5).Value, "B2") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X2").Rows(p1) If InStr(Cells(p0, 5).Value, "BA") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1) If InStr(Cells(p0, 5).Value, "BB") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1) If InStr(Cells(p0, 5).Value, "BC") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1) If InStr(Cells(p0, 5).Value, "B4") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X4").Rows(p1) If InStr(Cells(p0, 5).Value, "BB4") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X4").Rows(p1) If InStr(Cells(p0, 5).Value, "BB3") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X4").Rows(p1) If InStr(Cells(p0, 5).Value, "XX") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("XY").Rows(p1) If InStr(Cells(p0, 5).Value, "XV") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("XK").Rows(p1) p1 = p1 + 1 Next p0

---

Ce dernier fait partie d'une procédure plus complète mais je ne mets que la selection qui me pose problème.

J'ai un fichier qui varie de 5.000 à 30.000 lignes, et le petit code précédent, fait une recherche sur une partie de valeur dans la colonne E, et si la valeur est égale à HA (par exemple), copie la ligne complète dans l'onglet de destination (X2 pour cet exemple).

J'ai deux problèmes avec ce code.

1. Il est LONG !
Selon mon fichier, ce petit bout de code à une durée qui varie de 2minutes à 8-10minutes, et j'ai pourtant épuré la procédure autant que possible (j'ai déjà effectué une recherche sur la marche à suivre pour accelérer une macro, et suivi les conseils trouvés)

2. Je suis obligé de ré-organiser mes onglets de destination (avec un .sort)après l'utilisation de cette partie de macro, car des lignes vierges sont présentes un peu partout.

J'ai effectué des recherches plus ou moins avancées sur ces deux problèmes, mais je n'ai malheureusement que trop peu de temps par jour pour trouver une solution vraiment satisfaisante pour les besoins de mon travail.

Aussi ... Si quelqu'un avait la moindre idée d'une marche à suivre, d'une fonction, ou une boucle moins lourde ... Je serais très reconnaissant !

PS : Je ne demande pas nécessaire une solution toute faite (quoique ça ferait un bon gain de temps!), mais des idées, des conseils, des pensées...
Plusieurs cerveaux valent mieux qu'un :)

Par avance, merci ! :ccool:

Bonjour,

Tu peux gagner un peu de temps en remplaçant :

Code:

---

1 2 3

If InStr(Cells(p0, 5).Value, "BA") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1) If InStr(Cells(p0, 5).Value, "BB") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1) If InStr(Cells(p0, 5).Value, "BC") = 1 Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1)

---

par :

Code:

---

If Cells(p0, 5).Value Like "B[A-C]*" Then Cells(p0, 5).EntireRow.Copy Destination:=Sheets("X3").Rows(p1)

---

Pour éviter les lignes vides, il faut utiliser un pointeur pour chaque feuille :
p1 pour X3
p2 pour X4
p3 pour XY
p4 pour XK

Bonjour,

Et merci de ta réponse !

Malheureusement, concernant la lenteur, ça n'a pas changé (ou de façon insignifiante...). Je suis pourtant certain qu'il doit exister une solution ?

Peut-être avec une méthode de filtres, ou éventuellement une autre fonction vba à laquelle je n'aurais pas pensé ?

Pour le second point, là par contre c'est positif ! Merci de ton aide :)

Si quelqu'un avait la moindre idée, ou des suggestions à tester, je serais heureux de m'y jeter corps et âme.

Je me tire pas les cheveux, mais presque. :mrgreen:

Bonjour,
En faisant précéder ta procédure par l'instruction Application.ScreenUpdating =False cela va booster ton exécution
Tu pourrais aussi utiliser un Select Case à la place d'un IF

Bonjour,

Pour le point 1) : si tu veux vraiment gagner du temps sur ton code passe par des tableaux et limite les copies de plage. Voici un lien sur les tableaux, l'introduction est, à elle seule, très instructive: http://silkyroad.developpez.com/vba/tableaux/#LI
De quelques minutes tu passeras à quelques secondes.

Pour le point 2): il te faut un compteur par feuille (p1, p2, etc.) sinon nécessairement il y aura des lignes vides dans chacune d'entre elles.

Cordialement

Pour l'astuce du screenupdating, je l'ai déjà intégrée. Ainsi que les Calculate et Compagnie, malgré ça, ça reste trop lent. Mais merci quand même ;)

Quand au select case, ça pourrait être intéressant !

Ainsi que les variables tableaux.

Voilà quelque chose d'autre qui semble tout aussi intéressant, je vais me pencher dessus 8-)

Merci à tous pour les pistes à suivre :ccool: