optimisation de codeRésolu

Question

Bonjour,

j'utilise une macro excel pour éclater un certain nombre de lignes (environ 3000) qui sont du format pourcentage1, pourcentage2, pourcentage 3, ..., montant en autant de lignes pourcentagex*montant qu'il y a de champs pourcentages renseignés tout en vérifiant divers critères.

Apparament le code ci dessous donne a peu près le résultat attendu. Par contre, la vitesse d'éxecution diminue au fur et à mesure du traitement, rendant le temps d'exécution beaucoup trop long sur certaines machines, le rendant inexploitable (les 10 premières lignes passent sans problème sur ma machine, les suivantes sont plus lentes, et je craque en général avant la cinquantième).

J'ai tenté de spécifier au maximum les variables pour limiter l'occupation mémoire... peut être même un peu trop mais en tout cas sans réel effet (serait plus un problème de CPU que de mémoire apparament ?).

Auriez vous des idées pour optimiser le code ci dessous ?

mille mercis !

----------------------------------------------------------------
Sub eclatement_par_module(categorie)

' variables
Dim Ratios(8) As Single
Dim compteur_copies As Byte
Dim index_ligne As Integer
Dim reception1 As String
Dim reception2 As String
Dim nb_ligne_max As Integer
Dim index_colonne_annee As Byte
Dim index_colonne_categorie As Byte
Dim index_colonne_reception As Byte
Dim index_colonne_ratio1 As Byte
Dim index_colonne_ratio2 As Byte
Dim index_colonne_ratio3 As Byte
Dim index_colonne_ratio4 As Byte
Dim index_colonne_ratio5 As Byte
Dim index_colonne_ratio6 As Byte
Dim index_colonne_ratio7 As Byte
Dim index_colonne_ratio8 As Byte
Dim index_colonne_montant As Byte
Dim index_colonne_commentaire As Byte
Dim Formule As String
Dim index_ligne_mere As Integer
Dim nb_ratios As Byte
Dim ratio As Single
Dim i As Byte

Dim annee As Integer
Dim Reception_initiale As String
Dim Tag As String
Dim Montant As String

' paramètres
reception1 = "reception1 "
reception2 = "reception2 "
nb_ligne_max = 25000
index_colonne_annee = 1
index_colonne_categorie = 11
index_colonne_reception = 2
index_colonne_ratio1 = 14
index_colonne_ratio2 = 15
index_colonne_ratio3 = 16
index_colonne_ratio4 = 17
index_colonne_ratio5 = 18
index_colonne_ratio6 = 19
index_colonne_ratio7 = 20
index_colonne_ratio8 = 21 'correspond à la valeur tampon de reception 1
index_colonne_montant = 34
index_colonne_commentaire = 36

' parcours du tableau
For index_ligne = 2 To nb_ligne_max
    annee = Worksheets("Detail").Cells(index_ligne, index_colonne_annee).Value
    Reception_initiale = Worksheets("Detail").Cells(index_ligne, index_colonne_reception).Formula
    Tag = Worksheets("Detail").Cells(index_ligne, index_colonne_categorie).Formula
    Ratios(1) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio1).Value
    Ratios(2) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio2).Value
    Ratios(3) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio3).Value
    Ratios(4) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio4).Value
    Ratios(5) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio5).Value
    Ratios(6) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio6).Value
    Ratios(7) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio7).Value
    Ratios(8) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio8).Value
    Montant = Worksheets("Detail").Cells(index_ligne, index_colonne_montant).Formula
    Formule = Worksheets("Detail").Cells(index_ligne, index_colonne_montant).Formula
    
    
    ' ligne qui matche sur l'année de référence : à éclater
    If Tag categorie And Reception_initiale "reception1" Then
                        
        ' coloriage de la ligne mère
        Worksheets("Detail").Cells(index_ligne, index_colonne_reception).Interior.ColorIndex = 22
        index_ligne_mere = index_ligne
        nb_ratios = 0
        
        For index_ratio = 1 To 8
            ratio = Ratios(index_ratio)
            If ratio > 0 Then
                ' compteur du nombre de ratios non vides
                nb_ratios = nb_ratios + 1
    
                ' copie de la ligne
                Rows(index_ligne_mere).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                Application.CutCopyMode = False
                
                ' incrémentation de la ligne pour passer à la ligne copiée
                index_ligne = index_ligne + 1
                
                'mise à jour de la ligne copiée :
                ' coloriage
                Worksheets("Detail").Cells(index_ligne, index_colonne_reception).Interior.ColorIndex = 22
                ' nouvelle formule
                If Left(Formule, 1) Chr(61) Then 'Chr(61) "="
                   new_formule = Formule & "*" & ratio
                Else
                    new_formule = "=" & Formule & "*" & ratio
                End If
                new_formule = Replace(new_formule, ",", ".") 'pour éviter les problèmes d'incompatibilités de valeurs à décimales
                Worksheets("Detail").Cells(index_ligne, index_colonne_montant).Formula = new_formule
                ' reception
                If index_ratio < 8 Then Worksheets("Detail").Cells(index_ligne, index_colonne_reception).Value = reception2
                ' valeurs des taux
                For i = 1 To 8
                    If i = index_ratio Then
                        Worksheets("Detail").Cells(index_ligne, index_colonne_ratio1 + i - 1).Value = 1
                    Else
                        Worksheets("Detail").Cells(index_ligne, index_colonne_ratio1 + i - 1).Formula = ""
                    End If
                Next i
                ' commentaires
                Worksheets("Detail").Cells(index_ligne, index_colonne_commentaire).Value = Worksheets("Detail").Cells(index_ligne, index_colonne_commentaire).Formula & " au pro-rata de la contribution à l'offre"
            
                ' décrémentation de l'index de ligne pour revenir à la ligne mère
                index_ligne = index_ligne - 1
            End If
        Next index_ratio
        
        ' suppression de la ligne mere et incrémentation de l'index de ligne pour sauter les lignes copiées
        Rows(index_ligne_mere).Select
        Selection.Delete Shift:=xlUp
        index_ligne = index_ligne + nb_ratios - 1
             
    End If
       
Next index_ligne

End Sub

F215468 · Accepted Answer

Problème a priori réglé, les bonnes options consistaient à :
- éviter de supprimer les lignes en écrasant les lignes existantes
- screenupdating = false et xlcalculationmanual 
- dans une moindre mesure la suppression des select
gain de vitesse approximatif total x5 par rapport à la première version

Merci à tous pour votre aide.

jmf0 n'est fait pas trop quand même, ce type de remarque ne sert pas spécialement la notorité des sponsors de ce forum, notoriété qui n'est déja pas au top en entreprise.

jmf0 · Answer

Bonjour,

déjà (et abstraction faite de tout le reste ) :

curieux ce :

For index_ligne = 2 To nb_ligne_max 
annee = Worksheets("Detail").Cells(index_ligne, index_colonne_annee).Value 
Reception_initiale = Worksheets("Detail").Cells(index_ligne, index_colonne_reception).Formula 
Tag = Worksheets("Detail").Cells(index_ligne, index_colonne_categorie).Formula 
Ratios(1) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio1).Value 
Ratios(2) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio2).Value 
Ratios(3) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio3).Value 
Ratios(4) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio4).Value 
Ratios(5) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio5).Value 
Ratios(6) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio6).Value 
Ratios(7) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio7).Value 
Ratios(8) = Worksheets("Detail").Cells(index_ligne, index_colonne_ratio8).Value 


Qui fait que ton tableau sera rempli par les valeurs corrspondante au dernier "locuteur" (comme chez Louis XVI, ma foi) à savoir Monsieur nb_ligne_max ...
Bizarre !

F215468 · Answer

bonjour,

merci pour cette réponse, mais j'ai peur de n'avoir pas tout compris (aïe, il me reste du chemin à parcourir...).

pour passer le traitement sur l'ensemble des lignes entre 2 et nb_max, je suis bien obliger de tout mouliner dans un for qui englobe le reste du code, non ? le for part de cet endroit et se termine avant le end sub (c'est sur que ce serait plus visible si l'indentation était passée au copier / coller ...).

jmf0 · Answer

L'indentation serait respectée si tu utlisais la balise CODE (dans le bandeau juste au dessus de ta zone de sisie de message) 
Mais même sans cela, on voit bien l'aspect bizarroîde de ce que je t'ai signalé ...

F215468 · Answer

Ta remarque est inexacte: je peux t'assurer que la boucle tourne correctement pour l'avoir vue mouliner ligne à ligne au débuggeur (sous excel 2002, j'aurais peut être du le préciser).

comme précisé dans le post initial : la macro fait ce qu'on lui demande... enfin, sur les premières lignes puis rame tellement qu'une ame charitable ne peut qu'achever le process agonisant avant la fin.

jmf0 · Answer

Bon...
Je viens, en lisant le reste de ton code, de voir la raison pour laquelle tu modifie à chaque tour de boucle, toutes les valeurs de ton tableau.
Ce n'est peut-être pas adroit de procéder ainsi. Regarde ce que peut être une structure (type défini par l'utilisateur), genre :
Private Type titi
    A as ...
    B as ....
    ....
End Type 
puis pointe vers elle dans ton code

cs_nitho · Answer

je me dois aussi de te faire la remarque que sous excel il est indispensable de commencer ton code par 

application.screenupdating = false 
et de le terminer par application.screenupdating = true

cela sauvegarde grandement les ressources de ton pc en évitant à excel de rafraichir l'affichage à chaque changement. commence par là.
Tu peux aussi sauvegarder la valeur de application.calculation puis faire application.calculation = xlcalculationmanual au début de ton code (en plus de application.screenupdating...) et à la fin remettre la valeur initiale de application.calculation.


nitho l'amateur

jmf0 · Answer

éviter par ailleurs d'utiliser des .SELECT (ralentisseurs inutiles) et leur préférer une utilisation directe des contenus...

jmf0 · Answer

La non indentation de ton code (sur cette page) n'étant pas présente, j'ai un preu le tournis en essayant de m'y retrouver..
Un "survol", cependant, me donne à penser qu'il estprobable quee ton traitement gagnerait en vitesse si tu transformais d'abord en tableau dynamique, traitait ce tableau, puis le réinjectais.

jmf0 · Answer

Et pourquoi fais-tu ta boucle sur 250000 lignes (nb_ligne_max = 25000) 
alors que :
pour éclater un certain nombre de lignes (environ 3000)
Pour le plaisir de faire travailler là où tu ne le souhaites point ?
Tu devrais pouvoir mieux "cerner" que de cette manière, non ?

Ces lignesd-là :

index_ligne = index_ligne + 1 
.....

index_ligne = index_ligne - 1
.........
index_ligne = index_ligne + nb_ratios - 1 
La derniè-re étant la pluis dangereuse puisque tu fais en plus varier nb_ratios par ailleurs....


Viennent faire varier le paramètre de ta boucle 
For index_ligne = 2 To nb_ligne_max 
C'est à la fois déconseillé et source de multiples croche-pieds éventuels...
Ce n'est définitivement pas adroit dans une boucle for, surtout lorsqu'on la fait de haut en bas !

Revenons à nos moutons, donc : tu demandes ce qu'il faut pour optimiser ce code ?
J'aurais tendance à te répondre : tout revoir, y compris la stratégie.
Ce code n'est à mon avis pas à améliorer, mais à réécrire totalement et avec une autre approche.
Voilà ... désoilé....

F215468 · Answer

bonjour,

merci pour vos réponses. comme vous vous en êtes apperçu, il s'agit d'un code écrit plus avec une philosophie "C" que VBA (cela doit être une histoire de gènes...)

j'ai tenté quelques unes des modifications suggérées : 
- screenupdating et .calculation : ont des effets foudroyants sur une machine récente (dans les 75% de gain de temps), mais pas sur une machine plus ancienne qui reste tout de même plantée avant la fin du traitement
- suppression des .select
- adaptation du critère de fin de boucle à la longueur effective du tableau à traiter
donc malheureusement pas d'amélioration notable.

je ne suis pas sur de savoir comment faire en utilisant des TCD tout en respectant la structure du fichier, il est impératif l'insertion se fasse ligne à ligne et pas par bloc (ABC doit devenir AA'BB'CC' et pas ABCA'B'C').

Ce que je ne comprends toujours pas, c'est pourquoi les premières itérations de la boucle sont tout à fait performantes, mais que le traitement rame à partir de la 20 - 30eme ligne sur mon poste ? Est ce qu'il existe des instructions qui peuvent fuiter en mémoire ?

merci

jmf0 · Answer

Je ne vois dans ton code rien qui pourrait être à l'origine d'une fuite de mémoire.
J'y vois par contre tout ce que je t'ai déjà exposé.
Il n'est pas, à ce propos, impossible que le principal facteur de ce que tu observes au bout d'un certain nombre de lignes traitées trouve son explication dans l'acrobatie hasrdeuse dont je t'ai parlé plus haut : la modification, presque sans cesse, dans ta boucle for, de son paramètre d'avancement !

Je ne puis que te répéter mon avis précédent : ce code est à repenser totalement, plutôt que de chercher un "rafistolage" qui ne pourrait qu'être lui-même hasardeux

F215468 · Answer

bonjour,

j'ai bien compris que mon approche à un problème de fond, mais le temps me manque pour renvoir l'ensemble du fichier.

En creusant un peu, je constate que l'essentiel du temps passé dans cette macro est causé par la méthode de suppression de ligne 
Rows(pof).Delete Shift:=xlUp

j'ai testé 3 manières différentes (suppression ligne par ligne, sélection de l'ensemble des lignes à supprimer puis suppression en une fois, séléction / suppressionpar blocs de 10 lignes). Aucune n'est significativement plus efficace que les autres.

Y a t'il une méthode meilleure (= plus rapide) qu'une autre pour supprimer un (gros) ensemble de lignes ?

jmf0 · Answer

Désolé, mais je répète : dans cette partie de croche-pieds (en mofifiant sans cesse la valeur d'avancement de ta boucle) faits de surcroît de la ligne la plus petite à la ligne la plus grande, tu t'y perds et tous avec toi ! ===>>> aucun autre conseil possible que ceux que tu as déjà reçus !
Que cherches-tu à faire ? Ajouter des causes de dégâts à celles déjà subies ?
Ma participation à cette discussion s'arrête ici pour moi .... Re-désolé/désolé/sédolé !

jmf0 · Answer

Mon dernier mot, maintenant :
Tu as dit :
j'ai bien compris que mon approche à un problème de fond, mais le temps me manque pour renvoir l'ensemble du fichier. 
Alors deux hypothèses :
hypothèse 1 : il s'agit là d'un exercice de cours et ma foi....===>> ce sera ta note
hypothèse 2 : c'est pour un travail dans ta boîte et c'est devenu urgent :
=>> tu peux alors travailler sur deux feuilles, analyser ligne par ligne la première et décider sur la deuxième. In fine, remplacer la première par la deuxième.
Voilà (en observant qu'entrre le moment où on t'a dit que l'approche était à revoir et maintenant, tu avais à mon avis largement le temps de tout recommencer autrement !)

bigfish_le vrai · Answer

Salut,

bien que ta demande ne soit peut être plus d'actualité je mi colle quand même 

Donc voici un code peut être pas plus rapide mais plus lisible et simplifier 

Sub eclatement_par_module(categorie)

' variables
Dim Ratios(8) As Single
Dim compteur_copies As Byte
Dim index_ligne As Integer
Dim reception1 As String
Dim reception2 As String
Dim nb_ligne_max As Integer
Dim index_colonne_annee As Byte
Dim index_colonne_categorie As Byte
Dim index_colonne_reception As Byte
Dim index_colonne_ratio(8) As Byte
Dim index_colonne_montant As Byte
Dim index_colonne_commentaire As Byte
Dim Formule As String
Dim index_ligne_mere As Integer
Dim nb_ratios As Byte
Dim ratio As Single
Dim i As Byte

Dim annee As Integer
Dim Reception_initiale As String
Dim Tag As String
Dim Montant As String

' paramètres
reception1 = "reception1 "
reception2 = "reception2 "
index_colonne_annee = 1
index_colonne_categorie = 11
index_colonne_reception = 2
For i = 1 To 8
    index_colonne_ratio(i) = i + 13
Next
index_colonne_montant = 34
index_colonne_commentaire = 36
With Worksheets("Detail")
    ' Recherche de la derniere valeur sur la colonne annee. C'est  ici que l'on devrait gagner en temps d'execution
    ' car la boucle sera limitée au nombre de valeur réel 
    nb_ligne_max = .Cells(.Columns(index_colonne_annee).Rows.Count, index_colonne_annee).End(xlUp).Row
    ' parcours du tableau
    For index_ligne = 2 To nb_ligne_max
        annee = .Cells(index_ligne, index_colonne_annee).Value
        Reception_initiale = .Cells(index_ligne, index_colonne_reception).Formula
        Tag = .Cells(index_ligne, index_colonne_categorie).Formula
        For i = 1 To 8
            Ratios(i) = .Cells(index_ligne, index_colonne_ratio(i)).Value
        Next
        Montant = .Cells(index_ligne, index_colonne_montant).Value
        Formule = .Cells(index_ligne, index_colonne_montant).Formula

        ' ligne qui matche sur l'année de référence : à éclater
        If Tag categorie And Reception_initiale "reception1" Then
            ' coloriage de la ligne mère
            .Cells(index_ligne, index_colonne_reception).Interior.ColorIndex = 22
            index_ligne_mere = index_ligne
            nb_ratios = 0
    
            For index_ratio = 1 To 8
                ratio = Ratios(index_ratio)
                If ratio > 0 Then
                    ' compteur du nombre de ratios non vides
                    nb_ratios = nb_ratios + 1
                
                    ' copie de la ligne
                    With .Rows(index_ligne_mere)
                        .Copy
                        .Insert Shift:=xlDown
                    End With
                    'Application.CutCopyMode = False /!\ ne sert à rien !
                
                    ' incrémentation de la ligne pour passer à la ligne copiée
                    index_ligne = index_ligne + 1
                
                    'mise à jour de la ligne copiée :
                    ' coloriage
                    .Cells(index_ligne, index_colonne_reception).Interior.ColorIndex = 22
                    ' nouvelle formule
                    If Left(Formule, 1) Chr(61) Then 'Chr(61) "="
                        new_formule = Formule & "*" & ratio
                    Else
                        new_formule = "=" & Formule & "*" & ratio
                    End If
                    new_formule = Replace(new_formule, ",", ".") 'pour éviter les problèmes d'incompatibilités de valeurs à décimales
                    .Cells(index_ligne, index_colonne_montant).Formula = new_formule
                    ' reception
                    If index_ratio < 8 Then .Cells(index_ligne, index_colonne_reception).Value = reception2
                    ' valeurs des taux
                    For i = 1 To 8
                        If i = index_ratio Then
                            .Cells(index_ligne, index_colonne_ratio(i)).Value = 1
                        Else
                            .Cells(index_ligne, index_colonne_ratio(i)).ClearContents
                        End If
                    Next i
                    ' commentaires
                    .Cells(index_ligne, index_colonne_commentaire).Text = .Cells(index_ligne, index_colonne_commentaire).Text & " au pro-rata de la contribution à l'offre"
                    
                    ' décrémentation de l'index de ligne pour revenir à la ligne mère
                    index_ligne = index_ligne - 1
                End If
            Next index_ratio
            ' suppression de la ligne mere et incrémentation de l'index de ligne pour sauter les lignes copiées
            Rows(index_ligne_mere).Delete Shift:=xlUp
            index_ligne = index_ligne + nb_ratios - 1
        End If
    Next index_ligne
End With
End Sub

Voila

A+

Optimisation de code

16 réponses

Votre réponse

Discussions similaires