Discussion :

[F215468]

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 !

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
 
Sub eclatement_par_module(categorie)
'Eclatement en deux des lignes de catégorie déterminée et ventilation des ratios plus tagage du payeur
 
' 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 = 5000
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 reception1
index_colonne_montant = 34
index_colonne_commentaire = 36
 
' avertissement
compteur_copies = 0
 
' 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 la 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
 
    ' reinitialisation des objets
    annee = 0
    Reception_initiale = ""
    Tag = ""
    Montant = ""
    i = 0
    index_ligne_mere = 0
 
Next index_ligne
 
End Sub

[ucfoutu]

Bonjour,

je veux bien regarder ensuite le reste, mais j'attends que tu m'expliques d'abord cette fort curieuse partie :
' parcours du tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
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, modifiant à chaque fois les mêmes index de ton tableau, fait que seule la dernière modif aura raison !...

[F215468]

je peux t'assurer, pour l'avoir testé ligne à ligne au débugguer, que la première boucle du for permet d'initialiser les variables avec index_ligne = 2, puis de réaliser les traitements qui suivent avec ces valeurs, qu'à la deuxième boucle on passe à 3 etc... en gros on a bien :
for ...
traitements...
next...

et pas :
for...
next...
traitements...

ou alors je n'ai rien compris au vb...

ps: comme précisé dans le post initial, le code fonctionne jusqu'au bout (même en l'exécutant ligne à ligne je n'ai pas vu la boucle tourner 50000 fois sur elle meme avant de passer à la suite), il s'agit d'un problème de perf (voire même de code écrit comme un goret).

[ucfoutu]

Je ne veux ps douter une seule seconde de ce que ton code fonctionne...
Mais tu as ouvert cette discussion en vue de son optimisation, n'est-ce-pas ?
Et je t'ai donc montré, d'entrée de jeu et sans avoir encore examiné le reste, une curiosité assez étrange ...

En lisant maintenant le reste, je vois pourquoi tu modifies à chaque fois ton tableau et à quelles fins tu le fais.
Tu devrais t'intéresser de plus près aux variables d'un type défini par l'utilisateur(structures).

[ucfoutu]

Re...

J'ai eu il y a quelques minutes le temps de lire tout ton code...

Il n'est à mon avis pas à améliorer, mais à refondre totalement (trop de choses à mofifier et l'approche elle-même à reconsidérer ...)

- Ta boucle boucle systématiquement bien au-delà de la plage sur lauquelle tu veux finalement faire des traitements
. Tu modifies, au sein même de ta boucle, la valeur de son paramètre d'avancement : déconseillé et risqué, surtout dans le sens (du plus petit au plus grand) du "pas" de ta boucle (... une petite usine à gaz ...)

Cà, c'est pour l'approche ...

Pour la forme elle-même, maintenant : tes "Select" ne sont pas les meilleurs venus et devraient pouvoir être remplacés par l'utilisation directe des cellules ou de la plage des cellules...

Pas grand-chose de ton code à améliorer, mais probablement, donc, tout à reconsidérer .....

[pgz]

Bonjour.

Ce qui prend du temps dans la procédure, c'est toutes ces opérations de lecture et ecriture dans une feuille.
Par exemple tu lis cellule par cellule une ligne, et cela une ligne après l'autre.
En utilisant des varaiables tableau, tu peux en une opération lire ou écrire tout un tableau. C'est là que tu vas pourvoir gagner du temps, dans une proportion formidable si le nombre de lignes est grand.

PGZ

[ucfoutu]

Bonjour, pgz,

Bien évidemment
Et ce : y compris pour une partie (pas forcément toutes) de son traitement...
Je pense exactement la même chose...

[pgz]

Bonjour ufoutu,

ET bon dimanche!

Amitiés,

PGZ

[F215468]

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 :
- suppression des .select
- adaptation du critère de fin de boucle à la longueur effective du tableau à traiter
sans malheureusement pas d'amélioration notable.

Pour les traitements en masse en utilisant des tableaux je ne suis pas sur de savoir comment faire, il est impératif que je conserve l'ordre des lignes, et que l'insertion se fasse ligne à ligne et pas par bloc (ABC doit devenir AA'BB'CC' et pas ABCA'B'C'). A suivre.

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 fuitent en mémoire ?

merci

[ucfoutu]

Je ne vois aucune fuite en mémoire (puisque tu ne crées rien de plus en mémoire)
Je vois par contre tout ce dont je t'ai parlé plus haut, en passant par les croche-pieds éventuels dans ta boucle (mais pas uniquement)

Je te l'ai dit : ce code, tel qu'il est écrit, ne saurait être vraiment amélioré. Sa refonte totale est à envisager.

[Pierre Fauconnier]

Salut.

Peut-être désactiver le calcul automatique, vérifier que tu as bien remplacé les .select par l'utilisation directe des objets comme l'a énoncé Ucfoutu, peut-être aussi geler l'affichage pendant l'exécution de la macro

Mais surtout...

Comme l'a dit Ucfoutu , revoir entièrement ton code, d'abord par une approche du process avant de te lancer dans le codage

=>

Que cherches-tu à réaliser?

[askan]

Bonjour tout le monde,

Toujours dans cette optique d'optimisation de code, rajouter ces deux lignes de code aide a l'optimisation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Par contre, en supposant que j'ai une macro qui appelle trois autres macros successivement, pensez-vous qu'il est preferable de rajouter a la fin de chacune de trois macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationManual

ou simplement a la troisieme avt End Sub.

Merci,
Askan

[laetitia]

bonjour tous tu peus faire comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Sub es()
'tes variables au plus juste important pour la vitesse
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
'macro1
'macro2
'macro3
'macro4
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

re, un exemple plus concret variable en debut de module vu que les macros sont dans le meme module j'utilise la meme variable cela simplifier le code.2 macros tres lente pour l'exemple

Option Explicit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim i As Integer
Sub es()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
essai1
essai2
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub essai1()
For i = 1 To 30000
[a1] = [a1] + 1
Next i
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub essai2()
For i = 1 To 30000
[a2] = [a2] + 1
Next i
End Sub

tu remarques que dans les 2 macros j'ai pas mis de ScreenUpdating = False ect..

[askan]

Merci Laetitia et à tous,

Vos réponses vont m'être utiles et j'espère qu'elles le seront également pour
F215468
A très bientôt
Askan