Discussion :

[garheb]

Bonjour à tous,

Donc voilou après quelques jours de travail et avec votre aide j'ai pu finalement faire une démonstration à mon tuteur d'un classeur fonctionnel.
Par contre, l'exécution prend entre 5 et 15 secondes, je me demandais donc si il n'y avait pas moyen d'optimiser tout ça, il doit y avoir des choses inutiles mais je n'en suis pas sur.
(je compte le temps en faisant un Debug.Print "début " & now()" au départ et pareil à la fin)

Par exemple les .Activate, est-ce qu'elles sont toutes nécessaires?

De plus, en plus du temps d'exécution, parfois Excel plante lorsque je lance la macro, je ne sais pas si c'est du à mon code, et je ne sais pas exactement durant quelle exécution ça se produit.

J'ai de plus 2 questions à vous poser:

- Cette macro marchera t-elle sous Excel 2010? Car le déploiement dans l'entreprise devrait se faire cette année.

- J'ai tenté d'ajouter une condition au code:

Code :

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

1
2
3
For Each lol In Range("G4:G" & cptJour + 3)
	lol.FormulaLocal = "=ARRONDI(" & Range("F" & lol.Row).Value & "/" & Range("E" & lol.Row).Value & "*  100;2)"
Next lol

(ne me demandez pas pourquoi j'ai appelé la variable comme ça, je n'avais seulement pas d'idée )
Qui est censée, si il y a erreur (en l'occurence division par 0), ne rien mettre au lieu de planter
Ce qui donne:

Code :

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

1
2
3
4
 
        For Each lol In Range("G4:G" & cptJour + 3)
            lol.FormulaLocal = "=SI(ESTERR(ARRONDI(" & Range("F" & lol.Row).Value & "/" & Range("E" & lol.Row).Value & "*100;2)),"", ARRONDI(" & Range("F" & lol.Row).Value & "/" & Range("E" & lol.Row).Value & "*100;2))"
        Next lol

Mais j'ai une erreur qui vient d'Excel, j'ai vérifié les paranthèses & les " et à priori pas de souci de ce coté là, je ne comprends pas.

Sinon voici le code entier(les noms de fichier ont été changés):

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
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
Sub updateAll()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
'déclarations des variables
    Dim annee As Integer, nbJourMois As Integer
 
    Dim somme As Long, amount As Long
 
    Dim cptJour As Byte, mois As Byte, nbJoursOuvres As Byte, cpt As Byte, i As Byte
 
    Dim premierJourMois As Date, dernierJourMois As Date, nbJourSem As Date
 
    Dim premierJourMoisString As String, derniereCell As String, derniereCellS As String, derniereCellT As String
    Dim derniereCellE As String, derniereCellN As String
 
    Dim wb As Workbook
 
    Debug.Print "Début " & Now()
 
    'initialisation de l'année en cours et du mois en cours
    annee = Year(Now())
    mois = Month(Now())
 
    'construction d'une date à partir de l'année et du mois courants
    'ici mois +1 pour ensuite l'utiliser pour connaitre le dernier jour du mois:
    'on prend le premier jour du mois suivant puis on enlève un jour
    premierJourMoisString = "01/" & mois + 1 & "/" & annee
 
    'détermination du dernier jour du mois à partir de premierJourMoisString
    dernierJourMois = Format(DateAdd("d", -1, premierJourMoisString), "yyyy-mm-dd")
 
    'remplacement du premier jour du mois suivant par la date du premier jour du mois en cours
    premierJourMoisString = "01/" & mois & "/" & annee
 
    'conversion de la date premierJourMoisString en format date valide
    premierJourMois = Format(premierJourMoisString, "yyyy-mm-dd")
 
    'Variable contenant le nombre de jours dans le mois courrant.
    nbJourMois = (dernierJourMois - premierJourMois) + 1
 
    'Vérification visuelle des informations
    Debug.Print "Premier jour du mois: " & premierJourMois & " Dernier jour du mois: " & dernierJourMois
 
    'Compte le nombre de jours ouvrés (lundi => vendredi) sur le mois
    nbJoursOuvres = networkdays(premierJourMois, dernierJourMois)
    cpt = 0
    i = 1
    Workbooks("Synthèse.xls").Activate
    With Sheets(1)
        For Each c In [J4:J25]
            If Month(c) = mois Then
                wd = Weekday(c.Value, 2)
                Select Case wd
                    Case 1, 2, 3, 4, 5
                        cpt = cpt + 1
                    Case Else
                End Select
                i = i + 1
            End If
        Next c
    End With
    'prise en compte des jours fériés, à opti
    nbJoursOuvres = nbJoursOuvres - cpt
 
    'effacement de la zone avant insertion
    For Each c In [A4:G27]
        c.Value = ""
    Next c
 
    'déclaration d 'un compteur servant à vérifier que le nombre de jours ouvrés généré est correct
    'il sera incrémenté ensuite à chaque fois qu'un jour ouvré & non férié ou chômé est trouvé et inséré
    cptJour = 0
 
    'Boucle servant à déterminer quels jours sont ouvrés, puis les insérer dans une feuille excel
    For i = 1 To Format(dernierJourMois, "dd")
        'élimine les titres des colonnes des calculs
        If (IsNumeric(Cells(cptJour + 3, 3))) Then
            trueFalse = True
        Else
            trueFalse = False
        End If
 
        'sélectionne la feuille Synthese
        Sheets("Synthese").Activate
 
 
        Cells(cptJour + 4, 3).Select
        ActiveCell.FormulaLocal = "=TRONQUE(J2 / " & nbJoursOuvres & IIf(trueFalse, " + " & Cells(cptJour + 3, 3), "") & ")"
        Cells(cptJour + 4, 4).Select
        ActiveCell.FormulaLocal = "=TRONQUE(J3 / " & nbJoursOuvres & IIf(trueFalse, " + " & Cells(cptJour + 3, 4), "") & ")"
 
        'compteur servant à vérifier que la date en cours n'est pas une date fériée ou chômée
        cpt = 0
 
        'conversion de la date incrémentée (1er au dernier jour du mois) en numéro série
        'puis en format date français afin de faciliter la comparaison avec les dates entrées
        'en format français
        nbJourSem = Format(DateSerial(annee, mois, i), "dd/mm/yyyy")
        For Each c In [J4:J25]
            If c.Value Like nbJourSem Then
                cpt = cpt + 1
            End If
        Next c
 
        'si la date n'est pas contenu dans la colonne des fériés
        If (cpt = 0) Then
 
            'JourSemaine sert à déterminer à quel jour correspond la date générée, le second paramètre
            'est le format utilisé, ici le 2 veut dire lundi = premier jour de la semaine
            JourSemaine = Weekday(nbJourSem, 2)
 
            'switch, voir lorsque le jour en cours est un jour ouvrable
            Select Case JourSemaine
 
                'vérification du jour, lundi => vendredi
                Case 1, 2, 3, 4, 5
 
                    'Insère les dates générées dans la feuille excel en cours
                    'qui doit être Synthese
                    Cells(cptJour + 4, 2).Select
                    ActiveCell.FormulaR1C1 = nbJourSem
 
                    'incrémentation de cptJour, qui détermine le nombre de jours ouvrables traités
                    cptJour = cptJour + 1
                Case Else
            End Select
        End If
    Next i
 
    'met des bordures au tableau utilisé
    For Each cellule In Range("B3:G" & cptJour + 3)
        cellule.Borders.Weight = xlThin
    Next
 
    'vérification que le nombre de jours insérés est correct
    Debug.Print "nbJoursOuvres = " & nbJoursOuvres & " cptJour = " & cptJour
 
 
    cpt = 1
    'sert à générer le tableau de recap feuille recapAnnee
    'et met les bordures
    With Sheets(2)
        Sheets(2).Activate
 
        'rempli la colonne des mois
        Do While (cpt <= 12)
            .Range("B" & cpt + 3).Value = MonthName(cpt, False)
            cpt = cpt + 1
        Loop
        'rempli les titres de colonne
        .Range("C3").Value = "PARTS"
        .Range("C3").Borders.Weight = xlThin
        .Range("D3").Value = "UPGRADE"
        .Range("D3").Borders.Weight = xlThin
        .Range("E3").Value = "TOTAL"
        .Range("E3").Borders.Weight = xlThin
        .Range("B16").Value = "TOTAL EN COURS"
        .Range("B4:E16").Borders.Weight = xlThin
    End With
 
    cpt = 1
    'Ouvre le fichier dont les données sont à extraire
    Set wb = Workbooks.Open(ThisWorkbook.path & "\FichierSource1.xls")
    Workbooks("Synthèse.xls").Sheets(1).Activate
 
    'va chercher les données, compte tenu des jours ouvrés
    With Sheets(1)
 
        'parcoure les dates ouvrées
        For Each d In Range("B4:B" & cptJour + 3)
            j = Format(d, "dd")
            m = Format(d, "mm")
'CHANGER
            Workbooks("FichierSource1.xls").Activate
'1
            'compte la longueur du tableau
            derniereCell = Range("S65536").End(xlUp).Row
            derniereCellS = "S" & derniereCell - 1
            derniereCellT = "T" & derniereCell - 1
 
            With Sheets(1)
 
                'lis les dates et les filtre pour ne garder que les dates du mois
                'dont le jour est inférieur à aujourd'hui
                For Each c In .Range("T4:" & derniereCellT)
 
                    'découpage des dates, pour comparer séparéments les mois et les jours
                    dayC = Format(c, "dd")
                    monthC = Format(c, "mm")
                    dayN = Format(Now(), "dd")
                    monthN = Format(Now(), "mm")
 
                    'vérifie que la date correspond au mois en cours et aux jours précédents celui ci
                    If (monthN = monthC And dayC < dayN) Then
 
                        'vérifie que la date est bien ouvrée
                        'et compte le montant des transactions
                        If (j = dayC And m = monthC) Then
                            tot = Range("S" & c.Row)
                            TotJour = TotJour + tot
                            typeClt = Range("D" & c.Row)
 
                            'regarde si il s'agit d'une transaction interne
                            'si oui, compte le montant
                            If (typeClt = "Internal") Then
                                totInt = totInt + tot
                            End If
                        End If
                    End If
                Next c
                'incrémente le jour ouvré
                cpt = cpt + 1
            End With
 
            Workbooks("Synthèse.xls").Sheets(1).Activate
 
            'insère les valeurs en k$
            If (Format(Range("B" & cpt + 2).Value, "dd-mm-yyyy") < Format(Now(), "dd-mm-yyyy")) Then
                Range("E" & cpt + 2).FormulaLocal = "=ARRONDI(" & TotJour & ";-3)/1000"
                Range("F" & cpt + 2).FormulaLocal = "=ARRONDI(" & totInt & ";-3)/1000"
            End If
        Next d
 
        'compte les transactions internes en %
        For Each lol In Range("G4:G" & cptJour + 3)
            lol.FormulaLocal = "=SI(ESTERR(ARRONDI(" & Range("F" & lol.Row).Value & "/" & Range("E" & lol.Row).Value & "*100;2)),"", ARRONDI(" & Range("F" & lol.Row).Value & "/" & Range("E" & lol.Row).Value & "*100;2))"
        Next lol
    End With
 
    Set wb = Workbooks.Open(ThisWorkbook.path & "\FichierSource2.xls")
 
    'sert à compter les upgrades
    With Workbooks("FichierSource2.xls").Sheets(1)
 
        'détermine la dernière ligne utilisée
        derniereCell = .Range("E65536").End(xlUp).Row
        derniereCellE = "E" & derniereCell - 1
        derniereCellN = "N" & derniereCell - 1
 
        'sert à insérer les montants par mois
        For cpt = 1 To Format(Now(), "mm")
 
            Workbooks("FichierSource2.xls").Activate
            amount = 0
 
            'parcoure le fichier et prend les montants
            For Each a In Range("E4:" & derniereCellE)
 
                moisC = MonthName(Format(a, "mm"), True)
                monthN = MonthName(cpt, True)
 
                'vérifie que le mois en cours (via cpt) correspond au mois de la cellule
                If (monthN = moisC) Then
 
                    'prend les données de la colonne N correspondant à la cellule parcourue
                    amount = amount + Range("N" & a.Row)
                End If
            Next a
 
            'insère le montant dans le fichier cible
            Workbooks("Synthèse.xls").Activate
            Sheets(2).Range("D" & cpt + 3) = amount
            Sheets(2).Range("D" & cpt + 3).Borders.Weight = xlThin
        Next cpt
    End With
 
    Set wb = Workbooks.Open(ThisWorkbook.path & "\FichierSource1.xls")
    wb.Worksheets(1).Activate
 
    'détermine la dernière ligne utilisée
    derniereCell = Range("S65536").End(xlUp).Row
    derniereCellS = "S" & derniereCell - 1
    derniereCellT = "T" & derniereCell - 1
 
    'initialise la somme
    somme = 0
 
    'sert à calculer le total des ventes pour chaque mois
    For cpt = 1 To 12
        totMois = 0
 
        'prend les montants du mois
        For Each c In Range("T4:" & derniereCellT)
            If (cpt = Month(c)) Then
                totMois = totMois + Range("S" & c.Row).Value
            End If
        Next c
 
        'arrondi le montant
        totMois = Round(totMois, 0)
 
        'insère les données des mois
        With Workbooks("Synthèse.xls").Sheets(2)
            .Range("C" & cpt + 3).Value = totMois
            .Range("C" & cpt + 3).Borders.Weight = xlThin
        End With
    Next cpt
 
    'calcule le total de l'année
    For Each c In Range("S4:" & derniereCellS)
        somme = somme + c
    Next c
 
    'insère le montant de l'année
    With Workbooks("Synthèse.xls").Sheets(2)
        .Range("C16").Value = somme
        .Range("C16").Borders.Weight = xlThin
    End With
 
    'calcule le total pour chaque mois
    With Workbooks("Synthèse.xls").Sheets(2)
        Workbooks("Synthèse.xls").Sheets(2).Activate
        For Each c In Range("E4:E16")
            'Debug.Print c
            c.Value = Range("C" & c.Row) + Range("D" & c.Row)
            c.Borders.Weight = xlThin
        Next c
    End With
 
    'remet en route l'affichage
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Debug.Print "finish " & Now()
End Sub

[jfontaine]

Bonjour,

Y a-t-il une raison de mettre des valeurs en dur dans la formule plutôt que la référence aux cellules. Dans ton cas tu perds le coté dynamique de la formule si modification d'une des valeurs

Code :

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

1
2
3
For Each lol In Range("G4:G" & cptJour + 3)
    lol.FormulaLocal = "=SI(ESTERR(ARRONDI(F" & lol.Row & "/E" & lol.Row & ";2));"""";ARRONDI(F" & lol.Row & "/E" & lol.Row & ";2))"
 Next lol

[garheb]

Pas de raison particulière sinon que je ne vois pas comment faire autrement, mais je suis toujours preneur pour des modifications

Merci pour la correction ça fonctionne comme ça ^^

[garheb]

Bonjour!

Une autre question: Dans mon tableau j'ai seulement les jours ouvrés. A partir de ces dates & de chiffres divers, je sors les valeurs par jour. Ca fonctionne bien, pas de souci.

Par contre, comme je le disais il n'y a que les jours ouvrés, alors que dans le graph, il prend tous les jours du mois. Comment puis-je faire en sorte qu'il ne prenne que les jours indiqués dans le tableau? Car automatiquement il met tous les jours manquants.

Dans le tableau les jours sont dans ce format:
01/06/2011
06/06/2011
07/06/2011
08/06/2011
09/06/2011
10/06/2011
14/06/2011
15/06/2011
16/06/2011
17/06/2011
20/06/2011
21/06/2011
22/06/2011
23/06/2011
24/06/2011
27/06/2011
28/06/2011
29/06/2011
30/06/2011

Pour jfontaine, je ne vois pas tellement comment prendre des références dans le code, comment puis-je m'y prendre? Faire un cells("x, x").Select puis utiliser ensuite Active.Cells?

Je vous remercie d'avance.

Edit: J'ai trouvé pour le graph. Pour d'éventuels personnes qui ne trouveraient pas: clic droit sur le graph, options du graphique, onglet axes et au lieu d'automatique, mettre "catégories".