Performance Excel 2000 et 2007

**Arlos** · 31/05/2010, 16h10

Bonjour,

J'ai un programme fait sous Visual Basic 6.0 qui va ouvrir un fichier csv dans un tableau Excel puis le met en forme et effectue des calculs.

Sous mes postes en Excel 2000, le traitement s'effectue en 1 minute.
Sous Excel 2007, il met plus de 30 minutes.

Je n'ai pas trouver dans la FAQ ou les Tuto ce qu'il y avait a changé dans mon code pour que ça fonctionne aussi bien sous Excel 2007 que 2000.

Pouvez vous me donner des pistes ?

Merci d'avance.

Invité · 31/05/2010, 16h32

Bonjour

Et que fais ton code ? Est-ce que l'on peut avoir un aperçu de celui-ci ?

Philippe

**Arlos** · 31/05/2010, 16h44

Bonjour Philippe,

Voici des extraits (j'ai enlevé des parties notamment pour la mise en page).

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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
Option Explicit
 
Private xlApp As Excel.Application
Private xlBook As Excel.Workbook
Private xlSheet As Excel.Worksheet
 
Private Sub Form_Load()
 
 
 
        ' --- Declaration des variables
        Dim fso 'As Scripting.FileSystemObject
        Set fso = CreateObject("Scripting.FileSystemObject")
        Dim DateDuJour As String
        Dim DateEnCours As Date
        etc ...
' --- Fin / Declaration des variables
 
        ' --- Calcul de l'heure
        If Hour(Time) < 10 Then
        Heures = "0" & Hour(Time)
        Else
        Heures = Hour(Time)
        End If
        If Minute(Time) < 10 Then
        Minutes = "0" & Minute(Time)
        Else
        Minutes = Minute(Time)
        End If
        ' --- Fin / Calcul de l'heure
 
 
 
        ' --- Calcul du jour sous la forme jjmmaa
        If Day(Date) < 10 Then
        Jour = "0" & Day(Date)
        Else
        Jour = Day(Date)
        End If
 
        If Month(Date) < 10 Then
        Mois = "0" & Month(Date)
        Else
        Mois = Month(Date)
        End If
 
        Annee = Right(Year(Date), 2)
 
        DateDuJour = Jour & Mois & Annee
        ' --- Fin / Calcul du jour sous la forme jjmmaa
 
 
        ' --- Ouvre Excel mais ne l'affiche pas à l'écran
        Set xlApp = New Excel.Application
        xlApp.Visible = True
        ' --- Fin / Ouvre Excel mais ne l'affiche pas à l'écran
 
        fso.CopyFile "C:\CreationReportingRV.flv", "C:\AgendaNotes\CreationReportingRV.flv"
 
        ' --- Import du fichier de données avec délimiteur ;
                 Workbooks.OpenText FileName:="C:\CreationReportingRV.flv", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1))
    ActiveWindow.SmallScroll Down:=0
    ' --- Fin / Import du fichier de données avec délimiteur ;
 
 
    Application.ScreenUpdating = False
        ActiveSheet.DisplayAutomaticPageBreaks = False
 
    '******* FICHIER DATE
    Workbooks.OpenText FileName:="C:\CreationReportingDate.flv", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), _
        Array(2, 4))
    Windows("CreationReportingDate.flv").Activate
    Range("A1:B1").Select
    Selection.Copy
    Windows("CreationReportingRV.flv").Activate
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"
    Windows("CreationReportingDate.flv").Activate
    ActiveWindow.Close
 
 
        Application.DisplayStatusBar = False
 
    Sheets("CreationReportingRV").Select
    Sheets.Add
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "ReportingActivites"
    ActiveWindow.DisplayGridlines = False
 
 
 
       Range("A3").Select
    ActiveCell.FormulaR1C1 = "LUNDI"
    Range("B3").Select
        ActiveCell.FormulaR1C1 = "MARDI"
    Range("C3").Select
        ActiveCell.FormulaR1C1 = "MERCREDI"
    Range("D3").Select
        ActiveCell.FormulaR1C1 = "JEUDI"
    Range("E3").Select
        ActiveCell.FormulaR1C1 = "VENDREDI"
    Range("F3").Select
        ActiveCell.FormulaR1C1 = "SAMEDI"
    Range("G3").Select
        ActiveCell.FormulaR1C1 = "DIMANCHE"
    Range("H3").Select
 
 
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("A2:C2").Select
    Selection.AutoFill Destination:=Range("A2:G2"), Type:=xlFillDefault
    Range("A2:G2").Select
 
 
 
 
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ CALCUL DES JOURS ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤$
 
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=IF(WEEKDAY(R1C10)=R[-2]C,R1C10,"""")"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]<>"""",RC[-1]+1,IF(WEEKDAY(R1C10)=R[-2]C,R1C10,""""))"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "5"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "6"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "7"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A5").Select
    Columns("A:A").EntireColumn.AutoFit
    ActiveCell.FormulaR1C1 = _
        "=IF(R[-1]C[6]<>"""",R[-1]C[6]+1,IF(WEEKDAY(R1C10)=R[-3]C[6],R1C10,""""))"
    Range("A5").Select
    Selection.AutoFill Destination:=Range("A5:A8"), Type:=xlFillDefault
    Range("A5:A8").Select
    Range("B5").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(IF(RC[-1]<>"""",RC[-1]+1,""a"")>R1C11,"""",IF(RC[-1]<>"""",RC[-1]+1,""""))"
 
       Range("A4:G9").Select
    Selection.NumberFormat = "m/d/yyyy"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("A4:G9").Select
    Selection.Copy
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("L9").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A6").Select
 
 
 
  DateDeb = Range("J1").Value
  DateFin = Range("K1").Value
 
 
   ' ************************************************
   ' ******* INSERTION DES RESULTATS  ***************
   ' ************************************************
 
 
' ********** PARAMETRAGE DE BASE
DateEnCours = Format(Range("J1").Value, "dd/mm/yyyy")
NbJours = 1
Semaine = 0
LigneExcel = 6
NbLignes = 1
NbLignesMax = 0
 
Do While NbJours < CDate(DateFin) - CDate(DateDeb)
 
ColonneExcel = Colonnes(NbJours)
 
 
 
' ********** PARAMETRAGE EN FONCTION DE LA SEMAINE
 
  '--------- SEMAINE 1
 
  If DateEnCours <= FinSemaine1 Then
  Semaine = 1
  ColonneExcel = Colonnes(NbJours)
 
 
  If DateEnCours = DateDeb Then
 
 
 
  LigneSemaine1 = 4
   LigneSemaineEnCours = LigneSemaine1 + 1
 
  J = 0
   Do While J < 30
   Rows(LigneSemaine1 + 1 + NbLignesMax & ":" & LigneSemaine1 + 1 + NbLignesMax).Select
   Selection.Insert Shift:=xlDown
   J = J + 1
   Loop
    End If
 
  End If
 
 
  '--------- SEMAINE 2
 If DateEnCours >= DepSemaine2 And DateEnCours <= FinSemaine2 Then
 
 
 
 
  Semaine = 2
  If DateEnCours = DepSemaine2 Then
  Rows(LigneSemaine1 + 1 + NbLignesMax & ":" & LigneSemaine1 + 1 + 30 - 1).Select
Selection.Delete Shift:=xlUp
 
J = 0
   Do While J < 30
   Rows(LigneSemaineEnCours + 1 + NbLignesMax & ":" & LigneSemaineEnCours + 1 + NbLignesMax).Select
   Selection.Insert Shift:=xlDown
   J = J + 1
   Loop
 
  LigneSemaine2 = LigneSemaine1 + 1 + NbLignesMax
  LigneSemaineEnCours = LigneSemaine2 + 1
  NbLignesMax = 0
  NbLignes = 0
  NbJours = 1
  End If
  ColonneExcel = Colonnes(NbJours)
 
 
 
  End If
 
 
 
      ' ************** NOMBRE DE RESULTATS DU FILTRE DATE
     Sheets("CreationReportingRV").Select
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=DateEnCours
 
     NbLignes = Evaluate("=subtotal(3,A:A)") - 1
 
     If NbLignes > NbLignesMax Then
     NbLignesMax = NbLignes
     End If
 
 
 
    ' *********** TRAITEMENT DES LIGNES DU FILTRE DATE
    If NbLignes <> 0 Then
 
 
    '** Copier Coller dans Onglet
    Sheets("CreationReportingRV").Select
    Cells.Select
    Selection.Copy
    Columns("A:Z").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ReportingActivites").Select
    Range("K1").Select
    ActiveSheet.Paste
    Range(ColonneExcel & LigneSemaineEnCours).Select
    Application.CutCopyMode = False
    '** Partie Contact
    Range(ColonneExcel & LigneSemaineEnCours).Select
    Application.CutCopyMode = False
    Range(ColonneExcel & LigneSemaineEnCours).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range(ColonneExcel & LigneSemaineEnCours).Select
 
 
 
    ActiveCell.FormulaR1C1 = _
  "=IF(R[" & -LigneSemaineEnCours + 2 & "]C11<>"""",R[" & -LigneSemaineEnCours + 2 & "]C13,"""")"
 
 
    If NbLignes > 1 Then
 
    Selection.AutoFill Destination:=Range(ColonneExcel & LigneSemaineEnCours & ":" & ColonneExcel & LigneSemaineEnCours + NbLignes - 1), Type:=xlFillDefault
    End If
 
    Range(ColonneExcel & LigneSemaineEnCours & ":" & ColonneExcel & LigneSemaineEnCours + NbLignes - 1).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("K:AS").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
End If
 
 
 
 
      NbJours = NbJours + 1
      DateEnCours = DateEnCours + 1
       Sheets("ReportingActivites").Select
     Loop
 
 
        ' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ MISE EN PAGE ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
 
     Columns("A:N").Select
    Columns("A:N").EntireColumn.AutoFit
    Range("F9").Select
 
     Rows("1:200").Select
    Selection.RowHeight = 25.5
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Columns("A:AX").Select
    Selection.ColumnWidth = 31.86
    With ActiveSheet.PageSetup
    .LeftHeader = ""
   .CenterHeader = ""
   .RightHeader = ""
        '.LeftFooter = ""
        '.CenterFooter = ""
        '.RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        '.PrintHeadings = False
        '.PrintGridlines = False
        '.PrintComments = xlPrintNoComments
        '.PrintQuality = -3
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        '.Draft = False
        .PaperSize = xlPaperA4
        '.FirstPageNumber = xlAutomatic
        '.Order = xlDownThenOver
        '.BlackAndWhite = False
        '.Zoom = False
        '.FitToPagesWide = 1
        '.FitToPagesTall = 1
    End With
 
 
 
 
    If NbLignesMax < 31 Then
    NbLignesMax = 31
    End If
    Rows(LigneSemaineEnCours + NbLignesMax & ":" & 150).Select
    Selection.Delete Shift:=xlUp
 
 
      Application.ScreenUpdating = True
 
 
    Range("A1").Select
           xlApp.ActiveWorkbook.SaveAs FileName:="C:\TEST_REPORTING.xls", FileFormat:=xlExcel5
      '  ActiveWindow.Close
 
 
     ' Sauvegarde et fermeture du fichier Excel
   ' xlApp.Application.Quit
    'xlApp.Quit
    'Set xlBook = Nothing
    'Set xlApp = Nothing
    ' Fin / Sauvegarde et fermeture du fichier Excel
 
 
 
        ' Fermeture de la form
Unload Form1
Set Form1 = Nothing
 
 
End Sub

Invité · 31/05/2010, 17h11

Bonjour

Ton code comprend beaucoup de Select et Activate, je t'invite à faire un tour sur le forum Excel et à faire une recherche avec ces mots, tu verras comment pallier cela.

Philippe

**Arlos** · 31/05/2010, 17h28

Merci c'est vrai que j'ai déjà lu qu'il fallait faire attention à ca.

Par contre, est-ce ces erreurs qui pourraient faire tourner mon programme 30 fois plus lentement sur 2007 que 2000 ?

Merci

Invité · 31/05/2010, 17h50

Bonjour

Je ne sais pas si cela en est la cause, mais en tout cas en mettant en pratique la suppression de ces Select, etc... cela améliorera très sensiblement la vitesse.

Philippe

**DarkVader** · 31/05/2010, 17h55

Bonjour,

Envoyé par Arlos

Merci c'est vrai que j'ai déjà lu qu'il fallait faire attention à ca.

Par contre, est-ce ces erreurs qui pourraient faire tourner mon programme 30 fois plus lentement sur 2007 que 2000 ?

Merci

La 1ère explication est généralement lié à la différence du nombre de lignes et de colonnes entre les 2 versions.
Par exemple faire une recherche de cellule non vide en partant du bas de la feuille fournira une latence très différente
selon que 10 000 cellules seront parcourues ou 1 million

**Arlos** · 01/06/2010, 11h33

Bonjour, merci pour votre aide !

Pour les select et activate, je suis entrain de rechercher par quoi remplacer, ça devrait aller.

Pour le nombre de lignes, c'est vrai qu'Excel 2007 en gére plus, donc un Cells.Select prendra plus de temps.

J'ai repéré 3 parties qui prennent beaucoup de temps :

Code :

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

1
2
3
4
5
Do While J < 30
xlApp.Rows(LigneSemaineEnCours + 1 + NbLignesMax & ":" & LigneSemaineEnCours + 1 + NbLignesMax).Select
Selection.Insert Shift:=xlDown
J = J + 1
Loop

Code :

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

1
2
3
Columns("K:AS").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

Code :

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

1
2
3
4
5
6
7
8
9
Sheets("CreationReportingRV").Select
    Cells.Select
    Selection.Copy
    Columns("A:Z").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ReportingActivites").Select
    Range("K1").Select
    ActiveSheet.Paste

Je vais d'abord me concentrer sur ces 3 points, mais je galère un peu !

**Arlos** · 01/06/2010, 16h00

Envoyé par Arlos

Code :

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

1
2
3
4
5
Do While J < 30
xlApp.Rows(LigneSemaineEnCours + 1 + NbLignesMax & ":" & LigneSemaineEnCours + 1 + NbLignesMax).Select
Selection.Insert Shift:=xlDown
J = J + 1
Loop

J'ai remplacé mon ancien code d'insert par ça :

Code :

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

1
2
3
4
5
6
7
8
9
Dim iR&, q&, k&
Rows(LigneSemaine1 + 1 + NbLignesMax & ":" & LigneSemaine1 + 1 + NbLignesMax).Select
iR = ActiveCell.Row
 
J = 0
Do While J < 30
Rows(iR).Insert
J = J + 1
Loop

Ca va beaucoup mieux !

Je progresse ...

Performance Excel 2000 et 2007

VB 6 et antérieur

Discussions similaires

Partager

Partager