Amélioration d'une macro pour une meilleur vitesse d'execution

Salut,

Il y a peut-être des erreurs de conception dans ton code.
Le coup de parcourir un tableau de haut en bas et de supprimer des lignes au fur et à mesure est risqué.
Le fait d'utiliser un Do Until .. Loop réduit le risque mais je vois aussi une boucle For.
cf. http://www.presence-pc.com/forum/ppc/Programmation/tuto...

En plus dans celle boucle For, tu utilises une sélection, qui peut varier !

Par ailleurs, comprends bien ce que tu fais et indente correctement ton code.

La variable Rws est au pluriel. Elle devrait être au singulier en toute logique.
Qu'est-ce que tableau ?

La condition de la ligne 5 est opposée à celle de la ligne 7. On ne devrait pas pouvoir entrer dans la boucle Do Until !
(ohlala, fatiqué zeb !)

-----------------

Autre chose. Si tu as des calculs itératifs lourds à faire sur tes données, il faudrait peut-être changer d'outil. Un tableur n'est pas vraiment fait pour ça.

Salut Zeb,

Merci de me donner un petit coup de main.

Même s'il marche, il y a surement de erreurs dans la conception de mon code et j'essaye de l'affiner progressivement.

J'étais parti au début sur une boucle For mais c'était autant voir encore plus long.

tableau1 correspond à

Set tableau = Workbooks.Open("D:\Documents and Settings\XXX\Bureau\nom du fichier.xlsm")

Set tableau1 = tableau.Worksheets(1)

Ce n'est pas des calculs lourds, c'est juste un calcul de cumul.
Pour être plus clair, j'ai un tableau répertoriant des produits. Lorsqu'une commande est passée, une nouvelle ligne est créée pour le même produit donc même libellé ou référence.
Seul deux ou trois cellules changent. Je souhaite donc cumuler les valeurs de ces cellules pour mettre ce cumul dans une cellule de la première ligne d'un produit.

La macro marche, mais c'est la vérification des lignes unes par unes qui prend un temps fou...

Je peux te transmettre le reste du code mais attention tu vas pleurer du sang  

ps : je corrige Rws

Pleurer du sang !
LOL avec les horreurs que j'ai pu voir ici, je suis blindé !

Bon, je me suis un peu gouré entre While et Until   Spa grave.
Mais c'est toi qui m'a enduit d'erreur avec le If inutile de la ligne 5.
Cette condition est déjà vérifiée par la boucle Do Until.

Alors comme je l'explique dans le topic linké plus haut, il faut partir du bas et remonter si tu veux supprimer des lignes.
Pour accélérer les choses. On va partir de la dernière ligne non vide et remonter jusqu'à la première (sauf si tu connais effectivement le début du tableau)

Pour déterminer cette dernière ligne, c'est facile, je donne des exemples dans le topic des trucs et astuces.
Bon, je suppose qu'on peut se fier au contenu de la colonne C (3ème colonne).

Dim curr_line As Range
 
' // On part du bas
Set current_line = tableau1.Cells(Rows.Count, 3).End(xlUp).EntireRow
 
Do While current_line.Row > 1
    ' // On compare avec la ligne juste au dessus
    If current_line.Cells(3).Value = current_line.Offset(-1).Cells(3).Value Then
        For cellule = 22 To 26
            current_line.Offset(-1).Cells(3).Value = current_line.Offset(-1).Cells(3).Value _
                                                   + current_line.Cells(3).Value
        Next
        ' // Et on monte d'un cran
        Set current_line = current_line.Offset(-1)
        ' // Et on supprime la ligne inutile
        current_line.Offset(1).Delete
    End If
Loop

Ce code devrait être plus efficace.
Étudie-le bien.

-------------------------------------

Comment ça, ce n'est pas assez rapide ?
Bon, si ta feuille est pleine de calculs, la suppression de ligne peut fortement ralentir le traitement.
Alors on va le faire a posteriori et en une seule fois.

Dim curr_line As Range
Dim lines_to_deleted As Range
 
' // On part du bas
Set current_line = tableau1.Cells(Rows.Count, 3).End(xlUp).EntireRow
 
Do While current_line.Row > 1
    ' // On compare avec la ligne juste au dessus
    If current_line.Cells(3).Value = current_line.Offset(-1).Cells(3).Value Then
        For cellule = 22 To 26
            current_line.Offset(-1).Cells(3).Value = current_line.Offset(-1).Cells(3).Value _
                                                   + current_line.Cells(3).Value
        Next
        ' // Et on monte d'un cran
        Set current_line = current_line.Offset(-1)
 
        ' // Et on ajoute la ligne inutile à la liste des bannis !
        Set lines_to_deleted = Union(lines_to_deleted, current_line.Offset(1)
    End If
Loop
 
' // Et tout à la fin, on supprime les lignes en trop.
lines_to_deleted.Delete

Bon, comme ce crétin de VB n'est pas fichu de faire l'union d'un truc vide et d'un truc plein, il faut différencier le cas de la première ligne à supprimer.

Dim curr_line As Range
Dim lines_to_deleted As Range
 
' // On part du bas
Set current_line = tableau1.Cells(Rows.Count, 3).End(xlUp).EntireRow
 
Do While current_line.Row > 1
    ' // On compare avec la ligne juste au dessus
    If current_line.Cells(3).Value = current_line.Offset(-1).Cells(3).Value Then
        For cellule = 22 To 26
            current_line.Offset(-1).Cells(3).Value = current_line.Offset(-1).Cells(3).Value _
                                                   + current_line.Cells(3).Value
        Next
        ' // Et on monte d'un cran
        Set current_line = current_line.Offset(-1)
 
        ' // Et on ajoute la ligne inutile à la liste des bannis !
        If lines_to_deleted Is Nothing Then
            Set lines_to_deleted = current_line.Offset(1))
        Else
            Set lines_to_deleted = Union(lines_to_deleted, current_line.Offset(1))
        End If
    End If
Loop
 
' // Et tout à la fin, on supprime les lignes en trop.
lines_to_deleted.Delete

Aux erreurs de frappe et étourderies habituelles près, ça devrait fonctionner  
 


EDIT:
Et tout ça sans prendre le risque d'utiliser ScreenUpdate, bien sûr  

Je regarde tout ça, j'adapte et je te tiens au courant.

Encore merci!  

"Je regarde tout ça, j'adapte et je te tiens au courant." au lieu de "je copie/colle sans rien essayer de comprendre et je pleurniche par ce que ça ne marche pas du premier coup" ?

           

Bon, ça a marché à nouveau avec ton système mais c'est toujours aussi lent.

J'ai essayé un autre code :

Dim rr As Integer, h As Integer
 
      tableau1.Activate
 
      APT = tableau1.Cells(Rows.Count, 3).End(xlUp).EntireRow.Row
 
      rr = 2
 
     For h = 2 To APT
 
      If tableau1.Cells(rr + 1, 3).Value = tableau1.Cells(rr, 3).Value Then
 
      tableau1.Cells(rr, 22).Value = tableau1.Cells(rr, 22).Value + tableau1.Cells(rr + 1, 22).Value
      tableau1.Cells(rr, 23).Value = tableau1.Cells(rr, 23).Value + tableau1.Cells(rr + 1, 23).Value
      tableau1.Cells(rr, 24).Value = tableau1.Cells(rr, 24).Value + tableau1.Cells(rr + 1, 24).Value
      tableau1.Cells(rr, 25).Value = tableau1.Cells(rr, 25).Value + tableau1.Cells(rr + 1, 25).Value
      tableau1.Cells(rr, 26).Value = tableau1.Cells(rr, 26).Value + tableau1.Cells(rr + 1, 26).Value
 
      Rows(rr + 1).Delete Shift:=xlUp
 
      Else
 
      rr = rr + 1
 
      End If
 
      Next h

Je me suis dit que l'avantage de celui là, c'est qu'il aurait tendance à boucler plus rapidement.

Mais c'est toujours aussi long.

J'en ai donc tirer la conclusion suivante :

- avec ton code les lignes sont supprimées à la fin de la macro mais c'est toujours aussi long.
- j'ai testé 3 codes différents qui tous, vérifient les lignes, effectuent les calculs et suppriment les lignes en trop, résultat trop long encore.
- que je parte de la fin ou du début du tableau ne change pas la rapidité.

Le problème viendrait donc du calcul en lui même et pas de la suppression/vérification de ligne.


Je ne sais pas, mais à mon avis à ce niveau on peut rien faire non?


ps : j'ai testé aussi le code ci-dessus avec une boucle For :

For cellule = 22 To 26
 
     current_line.Offset(-1).Cells(3, cellule).Value = current_line.Offset(-1).Cells(3, cellule).Value _
     + current_line.Cells(3, cellule).Value
 
     Next cellule

pas d'amélioriation...

Partir du bas permet d'éviter certain bug que je décris dans un autre topic dont je t'ai donné le lien.
Il est possible que tu ne tombes jamais dessus avec tes données.

Bon. Il reste la solution ScreenUpdate...

Bon ben j'ai intégré ScreenUpdate. Macro effectuée en 10 secondes au lieu des 10/15 minutes auparavant...

Je connaissais pas cette fonction et du coup je comprends pas pourquoi tu veux l'éviter à ce point.

J'ai fait une recherche pour trouver des réponses ou même un tuto, j'ai pas trouvé. Tu aurais un lien ou autre?

Merci  

Les macros sont très faciles à faire avec l'enregistreur intégré.
Le VB est un langage peu efficace et très permissif.
Beaucoup de néophytes s'y mettent sans avoir la moindre notion de programmation.

Ce qui fait qu'on retrouve de gros problèmes de conception dans les macros.

La plus générale des erreurs - induites par les exemples de code générés par l'enregistreur - est d'utiliser l'objet actif suite à une sélection, par exemple. Ce type de programmation produit des macros d'une lenteur épouvantable.

De plus, cacher ce que VBA fait faire à Excel n'est en général pas une bonne idée.

Ces deux raisons font que je conseille à ceux qui viennent chercher de l'aide ici, de revoir leurs macros : suppression des sélections, non utilisation du presse-papier, etc. Et dans 90% des cas, les résultats sont bluffants.

Dans les 10% restants, on peut mettre les romanohow qui font du traitement de masse dans leur tableur et à qui la désactivation de ScreenUpdate ne portera pas trop préjudice. Pourvu qu'en cas d'interruption du code, ils pensent à réactiver ScreenUpdate.

 

Bha écoute je n'ai qu'une chose à dire.

UN GRAND MERCI!

Continue comme ça, ça fait du bien de voir qu'on peut encore compter sur des gens sympa et aimable qui te file un coup de main sans rien demander en échange...

A bientôt  

Ah mais si je demande des choses :

- Qu'on respecte ce fichu règlement. Apparemment, cela ne t'a pas poser problème.
- Qu'on soit aimable et poli (sans verser dans obséquiosité) Mêmement.
- Qu'on marque comme résolue les questions résolues... Ah on me dit dans l'oreillette que ce topic n'est pas une question mais une discussion et qu'en tant que tel, ne pourra ce topic ne pourra pas être marqué comme résolu. Tans pis. Accorde des points à la solution quand tu créeras un prochain topic. C'est là la subtile différence   (le forum est en pleine migration, tout n'est pas (encore) génial).