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