Optimisation de code

**darkwall_37** · 10/10/2012, 09h14

Bonjour,

Je voudrais optimiser mon code car le temps d’exécution de la macro s'avère parfois important (3-5 min).

La fonction qui pose problème est computeData. Il y a 3 boucles for imbriquées sachant que dans le dernier cas, i,j,k variait de 1 à 300 ; 1 à 12000 ; 1 à 17.
Ça commence à faire pas mal d'itérations n'est ce pas.

Dans un premier temps, j'ai trouvé deux lignes de commande qui permettent de désactiver le rafraichissement de l'écran et la mise à jour des formules Excel à chaque modification du classeur. Il s'avère que je n'ai pas de formule, donc je l'ai mis pour la forme.

Ça m'a fait gagner un peu de temps sur le traitement global mais rien d'excessif.

J'ai pensé à trier les données. Comme je cherche i dans j, une fois i trouvé, je repars de j+1 et plus de j=1. Ça fait quelques économies supplémentaires.

Y a-t-il mieux à faire encore ?

Voici le code :

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
Option Explicit
 
Sub bilanMensuel()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
 
        Dim i, period(52), delta, F1_max, F3_max
 
        Call getIntervall(period(), delta)
        Call initF3(period(), delta, F1_max, F3_max)
        Call computeData(delta, period(), F1_max, F3_max)
        Call sumPerClient(delta, F3_max)
        Call sumPerMonth(delta, F3_max)
        Call checkSum(delta, F3_max)
        Call isSupToMillion(delta, F3_max)
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Sub initF3(period(), delta, F1_max, F3_max)
    Dim i, j
    i = 1
    j = 3
 
    Do
        Do
            F3.Cells(i, j) = ""
            If (i >= 2) Then
                F3.Cells(i, j).Interior.ColorIndex = xlNone
            End If
            j = j + 1
        Loop While F3.Cells(i, j) <> ""
 
        j = 3
        i = i + 1
    Loop While F3.Cells(i, j) <> ""
 
    F3_max = 2
    Do
        F3_max = F3_max + 1
    Loop While F3.Cells(F3_max, 2) <> ""
 
    F1_max = 1
    Do
        F1_max = F1_max + 1
    Loop While F1.Cells(F1_max, 2) <> ""
 
    For i = 2 To F3_max - 1
        For j = 3 To delta + 2
            F3.Cells(i, j) = 0
        Next j
    Next i
 
    For i = 1 To delta
               F3.Cells(1, i + 2) = period(i)
    Next i
 
    For i = 2 To F3_max
        For j = 1 To delta + 3
            If (i Mod 2 = 0) Then
                F3.Cells(i, j).Interior.ColorIndex = 15
            Else
                F3.Cells(i, j).Interior.ColorIndex = 16
            End If
        Next j
    Next i
 
    F3.Cells(1, 1) = "NOM"
    F3.Cells(1, 2) = "NUM CLIENT"
    F3.Cells(1, delta + 3) = "TOTAL CLIENT"
    F3.Cells(F3_max, 1) = "TOTAL MOIS"
 
 
End Sub
 
Sub getIntervall(period(), delta)
    Dim i, j, offset(2), dates(2), add_year, theMonth, theYear
 
    offset(1) = 0
    offset(2) = 0
 
    dates(1) = Cells(3, 1)
    dates(2) = Cells(3, 2)
 
    If (year(dates(1)) - year(dates(2)) = 0) Then
        offset(1) = Abs(Month(dates(1)) - Month(dates(2))) + 1
        delta = offset(1)
 
    Else
        offset(1) = 12 - Month(dates(1)) + 1
        offset(2) = Month(dates(2))
        delta = offset(1) + offset(2) + 12 * (Abs(year(dates(1)) - year(dates(2))) - 1)
 
    End If
 
    add_year = 0
    theMonth = Month(dates(1))
    theYear = year(dates(1))
 
    For i = 0 To delta
        If ((theMonth + i) Mod 13 = 0) Then
            add_year = add_year + 1
            theMonth = theMonth + 1
        End If
 
        period(i + 1) = ((theMonth + i) Mod 13) & "/01/" & (theYear + add_year)
    Next i
 
End Sub
 
Sub computeData(delta, period(), F1_max, F3_max)
    Dim i, j, k, new_j, temp_j
 
    new_j = 1
    For i = 2 To F3_max
        For j = new_j To F1_max
            If (F3.Cells(i, 2) = F1.Cells(j, 1)) Then
                temp_j = j
                For k = 1 To delta
                        If (Month(F1.Cells(j, 2)) = Day(period(k)) And year(F1.Cells(j, 2)) = year(period(k))) Then
                            F3.Cells(i, k + 2) = F3.Cells(i, k + 2) + F1.Cells(j, 3) * 1.196
                        End If
                Next k
            End If
        Next j
        new_j = temp_j
    Next i
End Sub
 
Sub sumPerClient(delta, F3_max)
    Dim i, j, sum
    For i = 2 To F3_max
        sum = 0
        For j = 3 To delta + 2
            sum = sum + F3.Cells(i, j)
        Next j
        F3.Cells(i, j) = sum
    Next i
End Sub
 
Sub sumPerMonth(delta, F3_max)
    Dim i, j, sum
    For i = 3 To delta + 2
        sum = 0
        For j = 2 To F3_max
            sum = sum + F3.Cells(j, i)
        Next j
        F3.Cells(F3_max, i) = sum
    Next i
End Sub
 
Sub checkSum(delta, F3_max)
    Dim i, sum(2)
 
    sum(1) = 0
    sum(2) = 0
 
    For i = 3 To delta + 2
        sum(1) = sum(1) + F3.Cells(F3_max, i)
    Next i
 
    For i = 2 To F3_max
        sum(2) = sum(2) + F3.Cells(i, delta + 3)
    Next i
 
    Debug.Print sum(1), sum(2)
 
    If Int(sum(1)) = Int(sum(2)) Then
        F3.Cells(F3_max, delta + 3) = sum(1)
    Else
        F3.Cells(F3_max, delta + 3) = "ERREUR"
    End If
End Sub
 
Sub isSupToMillion(delta, F3_max)
    Dim i
    For i = 3 To delta + 2
        If (F3.Cells(F3_max, i) >= 1000000) Then
            F3.Cells(F3_max, i).Interior.ColorIndex = 4
        Else
            F3.Cells(F3_max, i).Interior.ColorIndex = 3
        End If
    Next i
End Sub

Merci d'avance.

**issoram** · 10/10/2012, 10h37

Bonjour,

Passe par des tableaux plutôt que de parcourir de plages de cellules. le temps gagné sera conséquent (X20 au moins)

**darkwall_37** · 10/10/2012, 11h06

Il faut que je parcours une fois le fichiers excel pour mettre les données dans un tableau et ensuite je travail sur les tableaux ?

C'est bien ce que vous me conseillez ?

Cordialement.

**kiki29** · 10/10/2012, 11h27

Salut, à consulter

Optimisation de code

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager