Discussion :

[hantran]

Bonjour,

J'ai une macro qui, une fois déclenchée, fait des calculs sur chaque cellule sur un plage de 12058 lignes * 68 colonnes. J'ai mesuré son temps d'exécution : 67 secondes. Le trouvez-vous long ?

J'ai amélioré en mettant ScreenUpdating à False et xlCalculManual, le temps mesuré : 56 secondes.

Personnellement je le trouve encore long.

Y-a-t-il d'autre moyen pour le réduire encore plus?

[laetitia]

re, sans code cela va être difficile d'optimiser???

[hantran]

Le code fait beaucoupr de ligne je ne voudrais pas le mettre, mais si tu veux, voici la bête

note : nblinesppr vaut 12058

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
442
443
444
445
446
447
448
449
450
 
Private Sub ext_metreo_Click()
 
    ppr = fctGetFileNameDashBoards(ThisWorkbook.FullName)
    tmp = Workbooks(ppr).Sheets("PPR").Name
 
    MsgBox "Veuillez cliquer sur OK pour choisir et ouvrir le fichier Excel metreo"
 
   'ouverture du fichier de sauvergarde testmetro.xls
    FileToOpen = Application.GetOpenFilename()
    If FileToOpen <> False Then
    Workbooks.OpenText Filename:=FileToOpen
 
      'Garder en mémoire le nom de l'extract ouvert
       extract = fctGetFileNameReports(ActiveWorkbook.FullName)
 
      'Vérifier le bon fichier
       If Workbooks(extract).Sheets(1).Cells(1, 1) <> "Year" Then
         tmpmsg = MsgBox("Ce n'est pas le bon fichier", vbCritical, "Invalid File")
         Exit Sub
       End If
 
      'on vide les anciennes données
       Sheets(1).Activate
       Sheets(1).Rows("2:65000").Select
       Selection.ClearContents
       Sheets(2).Activate
       Sheets(2).Cells.Select
       Selection.ClearContents
 
      'Activer le sheet parametre3 pour récupérer tous les numéros de colonnes
       Workbooks(ppr).Sheets("parametre3").Activate
 
      'Numéros des colonnes
      'Ne pas confondre avec le contenu
      'ex : colNESP = colonne X , NESP = valeur d'une cellule dans colNESP
       colquote_num = Application.WorksheetFunction.VLookup("Quote #", ActiveSheet.[A:B], 2, False)
       colopp_num = Application.WorksheetFunction.VLookup("Opportunity #", ActiveSheet.[A:B], 2, False)
       colacc_name = Application.WorksheetFunction.VLookup("Account Name", ActiveSheet.[A:B], 2, False)
       colyea = Application.WorksheetFunction.VLookup("Year", ActiveSheet.[A:B], 2, False)
       colq = Application.WorksheetFunction.VLookup("Q", ActiveSheet.[A:B], 2, False)
       colfw = Application.WorksheetFunction.VLookup("FW", ActiveSheet.[A:B], 2, False)
       colpole = Application.WorksheetFunction.VLookup("Level 3 Name", ActiveSheet.[A:B], 2, False)
       colregion = Application.WorksheetFunction.VLookup("Level 4 Name", ActiveSheet.[A:B], 2, False)
       colpays = Application.WorksheetFunction.VLookup("Installation Country", ActiveSheet.[A:B], 2, False)
       colge_mod = Application.WorksheetFunction.VLookup("GE Modality", ActiveSheet.[A:B], 2, False)
       colcp = Application.WorksheetFunction.VLookup("CP", ActiveSheet.[A:B], 2, False)
       colqty = Application.WorksheetFunction.VLookup("Qty", ActiveSheet.[A:B], 2, False)
       coltot_equip_lp = Application.WorksheetFunction.VLookup("Total Equip List Price", ActiveSheet.[A:B], 2, False)
       colaop = Application.WorksheetFunction.VLookup("AOP", ActiveSheet.[A:B], 2, False)
       colsp_net = Application.WorksheetFunction.VLookup("SP Net Total", ActiveSheet.[A:B], 2, False)
       colTI = Application.WorksheetFunction.VLookup("TI", ActiveSheet.[A:B], 2, False)
       colNESP = Application.WorksheetFunction.VLookup("NESP", ActiveSheet.[A:B], 2, False)
       colicv = Application.WorksheetFunction.VLookup("ICV", ActiveSheet.[A:B], 2, False)
       colNLs = Application.WorksheetFunction.VLookup("NLs", ActiveSheet.[A:B], 2, False)
       colinstall = Application.WorksheetFunction.VLookup("Install", ActiveSheet.[A:B], 2, False)
       colwty = Application.WorksheetFunction.VLookup("Wty", ActiveSheet.[A:B], 2, False)
       colFMI = Application.WorksheetFunction.VLookup("FMI", ActiveSheet.[A:B], 2, False)
       colApps = Application.WorksheetFunction.VLookup("Apps", ActiveSheet.[A:B], 2, False)
       colSales_com = Application.WorksheetFunction.VLookup("Sales Comm", ActiveSheet.[A:B], 2, False)
       colAgent_com = Application.WorksheetFunction.VLookup("Agent Comm", ActiveSheet.[A:B], 2, False)
       colTot_com = Application.WorksheetFunction.VLookup("Total Comm", ActiveSheet.[A:B], 2, False)
       colTot_transp = Application.WorksheetFunction.VLookup("Total Transp", ActiveSheet.[A:B], 2, False)
       colOther = Application.WorksheetFunction.VLookup("Other", ActiveSheet.[A:B], 2, False)
       colCM = Application.WorksheetFunction.VLookup("CM", ActiveSheet.[A:B], 2, False)
       colCM_pct = Application.WorksheetFunction.VLookup("CM %", ActiveSheet.[A:B], 2, False)
       colpct_dis = Application.WorksheetFunction.VLookup("% Discount", ActiveSheet.[A:B], 2, False)
       colmmcmimpact = Application.WorksheetFunction.VLookup("MMCM Impact", ActiveSheet.[A:B], 2, False)
       colservice_flag = Application.WorksheetFunction.VLookup("Service Contract Flag", ActiveSheet.[A:B], 2, False)
       colservice_price = Application.WorksheetFunction.VLookup("Service Price USD", ActiveSheet.[A:B], 2, False)
       colservice_name = Application.WorksheetFunction.VLookup("Service Coverage", ActiveSheet.[A:B], 2, False)
       colcnt_warr = Application.WorksheetFunction.VLookup("Contract or Warranty", ActiveSheet.[A:B], 2, False)
       colSeg = Application.WorksheetFunction.VLookup("Segment", ActiveSheet.[A:B], 2, False)
       colEquip = Application.WorksheetFunction.VLookup("Equipment/Svc", ActiveSheet.[A:B], 2, False)
 
 
      'Gèle l'écran pendant l'exécution
       Application.ScreenUpdating = False
 
       'Application.Calculation = xlCalculationManual
 
      'on colle les colonnes du PPR dans la feuille
       Workbooks(ppr).Sheets(tmp).Activate
 
      'regrouper toutes les colonnes non consécutive pour copier une seule fois avec la méthode Union
      'la méthode Union a une limite de 30 arguments
       With Sheets(tmp)
            Union(.Columns(colquote_num), .Columns(colopp_num), .Columns(colacc_name), .Columns(colyea), .Columns(colq), _
                  .Columns(colfw), .Columns(colpole), .Columns(colregion), .Columns(colpays), .Columns(colge_mod), _
                  .Columns(colcp), .Columns(colqty), .Columns(coltot_equip_lp), .Columns(colaop), .Columns(colsp_net), _
                  .Columns(colTI), .Columns(colNESP), .Columns(colicv), .Columns(colNLs), .Columns(colinstall), _
                  .Columns(colwty), .Columns(colFMI), .Columns(colApps), .Columns(colSales_com), .Columns(colAgent_com), _
                  .Columns(colTot_com), .Columns(colTot_transp), .Columns(colOther), .Columns(colCM), .Columns(colCM_pct)).Copy
       End With
 
       Workbooks(extract).Sheets(2).Activate
       ActiveSheet.Cells(1, 1).Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
       Application.CutCopyMode = False
 
 
      'rajout service/occr
       Workbooks(ppr).Sheets(tmp).Activate
 
       With Sheets(tmp)
            Union(.Columns(colpct_dis), .Columns(colEquip), .Columns(colmmcmimpact), .Columns(colservice_flag), _
                  .Columns(colservice_price), .Columns(colservice_name), .Columns(colcnt_warr), .Columns(colSeg)).Copy
       End With
 
       Workbooks(extract).Sheets(2).Activate
       ActiveSheet.Cells(1, 31).Select
       Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
       Application.CutCopyMode = False
 
      'fin rajout
 
 
      'calcul nbre de lines fichiers
       nbrelines = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
      'enleve les date vide et services
       For t = nbrelines To 2 Step -1
 
           If Sheets(2).Cells(t, "D") = "" Or _
              Sheets(2).Cells(t, "AF") = "Services" Then
 
              Sheets(2).Rows(t & ":" & t).Delete Shift:=xlUp
           End If
       Next t
 
 
      'calcul nbre de lines fichiers
 
       nbrelines = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
 
      'enlever aop = 0
       For t = nbrelines To 2 Step -1
 
           If Sheets(2).Cells(t, "N") = 0 Then
 
              Sheets(2).Rows(t & ":" & t).Delete Shift:=xlUp
           End If
       Next t
 
 
      'calcul nbre de lines fichiers
 
       nbrelines = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
 
      'Calcull les bonnes données
       For t = 2 To nbrelines Step 1
 
          '----------------------------------------
          '            Données orders
          '----------------------------------------
 
          'Year
           Sheets(1).Cells(t, "A") = Left(Sheets(2).Cells(t, "D"), 4)
 
          'Quarter
           Sheets(1).Cells(t, "B") = Sheets(1).Cells(t, "A") & " Q" & Sheets(2).Cells(t, "E")
 
          'FW
           If Len(Sheets(2).Cells(t, "F")) > 1 Then
 
              Sheets(1).Cells(t, "C") = Sheets(1).Cells(t, "A") & " FW" & Sheets(2).Cells(t, "F")
 
           Else
 
              Sheets(1).Cells(t, "C") = Sheets(1).Cells(t, "A") & " FW0" & Sheets(2).Cells(t, "F")
 
           End If
 
          'Moved to EOB = order date
           Sheets(1).Cells(t, "D") = ""
 
          'Customer name
           Sheets(1).Cells(t, "E") = Sheets(2).Cells(t, "C")
 
          'Pole
           Sheets(1).Cells(t, "F") = Sheets(2).Cells(t, "G")
 
          'Region
           Sheets(1).Cells(t, "G") = Sheets(2).Cells(t, "H")
 
          'Ship to country
           Sheets(1).Cells(t, "H") = Sheets(2).Cells(t, "I")
 
          'PSI Modality desc
           Sheets(1).Cells(t, "I") = Sheets(2).Cells(t, "J")
 
          'Product name
           Sheets(1).Cells(t, "K") = Sheets(2).Cells(t, "K")
 
          'PSI name = Product_name (pour l'instant)
           Sheets(1).Cells(t, "J") = Sheets(1).Cells(t, "K")
 
          'Order status
           Sheets(1).Cells(t, "L") = ""
 
          'Purchase order
           Sheets(1).Cells(t, "M") = ""
 
          'equote order no
           Sheets(1).Cells(t, "N") = Sheets(2).Cells(t, "A")
 
          'force id
           Sheets(1).Cells(t, "O") = Sheets(2).Cells(t, "B")
 
          'psi qty
           Sheets(1).Cells(t, "P") = Sheets(2).Cells(t, "L")
 
          'list price
           'Si % Discount <= 0 ou >= 0.999
            If Sheets(2).Cells(t, "AE") <= 0 Or Sheets(2).Cells(t, "AE") >= 0.999 Then
               'alors list price = equip_revenue_usd à savoir equip_revenue_usd = NESP * 1000
                Sheets(1).Cells(t, "Q") = Sheets(2).Cells(t, "Q") * 1000
 
           'sinon list price = NESP * 1000 / (1 - % Discount)
            Else
               Sheets(1).Cells(t, "Q") = Sheets(2).Cells(t, "Q") * 1000 / (1 - Sheets(2).Cells(t, "AE"))
 
            End If
 
          'contract amount = net_selling_price_usd à savoir net_selling_price_usd = SP Net total * 1000
           Sheets(1).Cells(t, "R") = Sheets(2).Cells(t, "O") * 1000
 
          'neov = equip_revenue_usd
           Sheets(1).Cells(t, "S") = Sheets(2).Cells(t, "Q") * 1000
 
          'tradein amount = TI * 1000
           Sheets(1).Cells(t, "T") = Sheets(2).Cells(t, "P") * 1000
 
          'total discount = % discount * list price
           Sheets(1).Cells(t, "U") = Sheets(2).Cells(t, "AE") * Sheets(1).Cells(t, "Q")
 
          'occr amount
           Sheets(1).Cells(t, "V") = Sheets(2).Cells(t, "AG") * 1000
 
          'discount %
           Sheets(1).Cells(t, "W") = Sheets(2).Cells(t, "AE")
 
          'nl cost = NLs * 1000
           Sheets(1).Cells(t, "X") = Sheets(2).Cells(t, "S") * 1000
 
          'mm icv = ICV * 1000
           Sheets(1).Cells(t, "Y") = Sheets(2).Cells(t, "R") * 1000
 
          'sm pricing = equip_revenue_usd - NL Cost - MM ICV
           Sheets(1).Cells(t, "Z") = Sheets(2).Cells(t, "Q") * 1000 - Sheets(1).Cells(t, "X") - Sheets(1).Cells(t, "Y")
 
          'sm pricing % = sm pricing / equip_revenue_usd
           Sheets(1).Cells(t, "AA") = Sheets(1).Cells(t, "Z") / (Sheets(2).Cells(t, "Q") * 1000)
 
          'freight = total transp * 1000
           Sheets(1).Cells(t, "AB") = Sheets(2).Cells(t, "AA") * 1000
 
          'warranty = wty * 1000
           Sheets(1).Cells(t, "AC") = Sheets(2).Cells(t, "U") * 1000
 
          'installation
           Sheets(1).Cells(t, "AD") = Sheets(2).Cells(t, "T") * 1000
 
          'sales commision usd = sales comm * 1000
           Sheets(1).Cells(t, "AE") = Sheets(2).Cells(t, "X") * 1000
 
          'agent commision
           Sheets(1).Cells(t, "AF") = Sheets(2).Cells(t, "Y")
 
          'fmi = FMI * 1000
           Sheets(1).Cells(t, "AG") = Sheets(2).Cells(t, "V") * 1000
 
          'clinical apps = Apps * 1000
           Sheets(1).Cells(t, "AH") = Sheets(2).Cells(t, "W") * 1000
 
          'other ovc = other * 1000
           Sheets(1).Cells(t, "AI") = Sheets(2).Cells(t, "AB") * 1000
 
          'cm = CM * 1000
           Sheets(1).Cells(t, "AJ") = Sheets(2).Cells(t, "AC") * 1000
 
          'cm %
           Sheets(1).Cells(t, "AK") = Sheets(2).Cells(t, "AD")
 
          'target = neov - (vtgt aop * 1000)
          'pour l'instant, vtgt aop = 0
           Sheets(1).Cells(t, "AL") = Sheets(1).Cells(t, "S")
 
          'v target = vtgt aop * 1000
          'pour l'instant, v target = 0
           Sheets(1).Cells(t, "AM") = "0"
 
          'aop op = neov / psi qty - vop aop * 1000
          'pour l'instant, vop aop = 0
           Sheets(1).Cells(t, "AN") = Sheets(1).Cells(t, "S") / Sheets(1).Cells(t, "P")
 
          'aop = neov / psi qty
           Sheets(1).Cells(t, "AO") = Sheets(1).Cells(t, "S") / Sheets(1).Cells(t, "P")
 
          'v op = vop aop * 1000
          'pour l'instant, vop = 0
           Sheets(1).Cells(t, "AP") = "0"
 
          'wf list price =  list price
           Sheets(1).Cells(t, "AQ") = Sheets(1).Cells(t, "Q")
 
          'wf discount = total discount * -1
           Sheets(1).Cells(t, "AR") = Sheets(1).Cells(t, "U") * -1
 
          'wf net price = wf list price + wf discount
           Sheets(1).Cells(t, "AS") = Sheets(1).Cells(t, "AQ") + Sheets(1).Cells(t, "AR")
 
          'wf ge icv = mm icv * -1
           Sheets(1).Cells(t, "AT") = Sheets(1).Cells(t, "Y") * -1
 
          'wf nl cost = nl cost * -1
           Sheets(1).Cells(t, "AU") = Sheets(1).Cells(t, "X") * -1
 
          'wf sm pricing = sm pricing
           Sheets(1).Cells(t, "AV") = Sheets(1).Cells(t, "Z")
 
          'wf freight = freight * -1
           Sheets(1).Cells(t, "AW") = Sheets(1).Cells(t, "AB") * -1
 
          'wf sm = wf sm pricing + wf freight
           Sheets(1).Cells(t, "AX") = Sheets(1).Cells(t, "AV") + Sheets(1).Cells(t, "AW")
 
          'wf warranty = warranty * -1
           Sheets(1).Cells(t, "AY") = Sheets(1).Cells(t, "AC") * -1
 
          'wf installation = installation * -1
           Sheets(1).Cells(t, "AZ") = Sheets(1).Cells(t, "AD") * -1
 
          'wf sales commision = sales comm * -1
           Sheets(1).Cells(t, "BA") = Sheets(1).Cells(t, "AE") * -1
 
          'wf agent commision = agent comm * -1
           Sheets(1).Cells(t, "BB") = Sheets(1).Cells(t, "AF") * -1
 
          'wf fmi = FMI * -1
           Sheets(1).Cells(t, "BC") = Sheets(1).Cells(t, "AG") * -1
 
          'wf clinical apps = clinical apps * -1
           Sheets(1).Cells(t, "BD") = Sheets(1).Cells(t, "AH") * -1
 
          'wf other ovc = other ovc * -1
           Sheets(1).Cells(t, "BE") = Sheets(1).Cells(t, "AI") * -1
 
          'wf estimated cm = CM
           Sheets(1).Cells(t, "BF") = Sheets(1).Cells(t, "AJ")
 
          'wf occr amt = occr amount * -1
           Sheets(1).Cells(t, "BG") = Sheets(1).Cells(t, "V") * -1
 
          'wf estimated cm w/o occr amt = wf estimated cm + wf occr amt
           Sheets(1).Cells(t, "BH") = Sheets(1).Cells(t, "BF") + Sheets(1).Cells(t, "BG")
 
 
 
          '--------------------------------------
          '          Données services
          '--------------------------------------
 
          'Service requested flag
           Sheets(1).Cells(t, "BI") = Sheets(2).Cells(t, "AL")
 
          'Service Price
           Sheets(1).Cells(t, "BJ") = Sheets(2).Cells(t, "AI")
 
          'Service Contract Offering
            'Mappage avec vlookup
             On Error Resume Next
 
                Sheets(1).Cells(t, "BK") = Application.WorksheetFunction.VLookup(Sheets(2).Cells(t, "AJ"), _
                                           Workbooks(ppr).Sheets("parametre").[BC:BD], 2, False)
 
             If Err.Number > 0 Then
 
                Sheets(1).Cells(t, "BK") = ""
 
             End If
 
          'Service target price
          '
           Sheets(1).Cells(t, "BL") = 0
 
          'V Target service (%)
          'v target price % = service price % - service target price %
           Sheets(1).Cells(t, "BM") = 0
 
          'V Target service ($)
          'v target price $ = service price $ - service target price $
           Sheets(1).Cells(t, "BN") = 0
 
          'Contract type (Contract/Warranty/Both)
           Sheets(1).Cells(t, "BO") = Sheets(2).Cells(t, "AH")
 
              'Mappage
 
               Select Case Sheets(1).Cells(t, "BO")
 
                   Case "B"
                        Sheets(1).Cells(t, "BO") = "Both"
 
                   Case "C"
                        Sheets(1).Cells(t, "BO") = "Contract"
 
                   Case "W"
                        Sheets(1).Cells(t, "BO") = "Warranty"
 
                   Case "N"
                        Sheets(1).Cells(t, "BO") = "No"
 
               End Select
 
          'Segmentation
           Sheets(1).Cells(t, "BP") = Sheets(2).Cells(t, "AK")
 
       Next
 
      'Pour tous orders
       For t = 2 To nbrelines Step 1
        'Si % Discount <= 0 ou >= 1
         If Sheets(1).Cells(t, "W") <= 0 Or Sheets(1).Cells(t, "W") >= 1 Then
            'alors total discount = 0, wf discount = 0, wf net price = wf list price, % discount = 0
             Sheets(1).Cells(t, "U") = 0
             Sheets(1).Cells(t, "AR") = 0
             Sheets(1).Cells(t, "AS") = Sheets(1).Cells(t, "AQ")
             Sheets(1).Cells(t, "W") = 0
         End If
       Next
 
       Sheets(1).Activate
 
   Else
 
       MsgBox "Annulé !"
 
   End If
 
      'Réactiver l'écran
       Application.ScreenUpdating = True
 
       'Application.Calculation = xlCalculationAutomatic
 
End Sub

[Gorfael]

Salut hantran et le forum

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
Private Sub ext_metreo_Click()
ppr = fctGetFileNameDashBoards(ThisWorkbook.FullName)
tmp = Workbooks(ppr).Sheets("PPR").Name ' tmp="PPR", pas besoin de calcul
 
MsgBox "Veuillez cliquer sur OK pour choisir et ouvrir le fichier Excel metreo"
 
'ouverture du fichier de sauvergarde testmetro.xls
 FileToOpen = Application.GetOpenFilename()
 If FileToOpen <> False Then
    Workbooks.OpenText Filename:=FileToOpen
 
    'Garder en mémoire le nom de l'extract ouvert
     extract = fctGetFileNameReports(ActiveWorkbook.FullName)
 
    'Vérifier le bon fichier
     If Workbooks(extract).Sheets(1).Cells(1, 1) <> "Year" Then
        tmpmsg = MsgBox("Ce n'est pas le bon fichier", vbCritical, "Invalid File")
        Exit Sub
     End If
 
    'on vide les anciennes données
    Sheets(1).Rows("2:65000").ClearContents
    Sheets(2).Cells.ClearContents
 
    'Activer le sheet parametre3 pour récupérer tous les numéros de colonnes
    Workbooks(ppr).Sheets("parametre3").Activate
 
    'Numéros des colonnes
    'Ne pas confondre avec le contenu
    'ex : colNESP = colonne X , NESP = valeur d'une cellule dans colNESP
    colquote_num = Application.WorksheetFunction.VLookup("Quote #", ActiveSheet.[A:B], 2, False)
    colopp_num = Application.WorksheetFunction.VLookup("Opportunity #", ActiveSheet.[A:B], 2, False)
    colacc_name = Application.WorksheetFunction.VLookup("Account Name", ActiveSheet.[A:B], 2, False)
    colyea = Application.WorksheetFunction.VLookup("Year", ActiveSheet.[A:B], 2, False)
    colq = Application.WorksheetFunction.VLookup("Q", ActiveSheet.[A:B], 2, False)
    colfw = Application.WorksheetFunction.VLookup("FW", ActiveSheet.[A:B], 2, False)
    colpole = Application.WorksheetFunction.VLookup("Level 3 Name", ActiveSheet.[A:B], 2, False)
    colregion = Application.WorksheetFunction.VLookup("Level 4 Name", ActiveSheet.[A:B], 2, False)
    colpays = Application.WorksheetFunction.VLookup("Installation Country", ActiveSheet.[A:B], 2, False)
    colge_mod = Application.WorksheetFunction.VLookup("GE Modality", ActiveSheet.[A:B], 2, False)
    colcp = Application.WorksheetFunction.VLookup("CP", ActiveSheet.[A:B], 2, False)
    colqty = Application.WorksheetFunction.VLookup("Qty", ActiveSheet.[A:B], 2, False)
    coltot_equip_lp = Application.WorksheetFunction.VLookup("Total Equip List Price", ActiveSheet.[A:B], 2, False)
    colaop = Application.WorksheetFunction.VLookup("AOP", ActiveSheet.[A:B], 2, False)
    colsp_net = Application.WorksheetFunction.VLookup("SP Net Total", ActiveSheet.[A:B], 2, False)
    colTI = Application.WorksheetFunction.VLookup("TI", ActiveSheet.[A:B], 2, False)
    colNESP = Application.WorksheetFunction.VLookup("NESP", ActiveSheet.[A:B], 2, False)
    colicv = Application.WorksheetFunction.VLookup("ICV", ActiveSheet.[A:B], 2, False)
    colNLs = Application.WorksheetFunction.VLookup("NLs", ActiveSheet.[A:B], 2, False)
    colinstall = Application.WorksheetFunction.VLookup("Install", ActiveSheet.[A:B], 2, False)
    colwty = Application.WorksheetFunction.VLookup("Wty", ActiveSheet.[A:B], 2, False)
    colFMI = Application.WorksheetFunction.VLookup("FMI", ActiveSheet.[A:B], 2, False)
    colApps = Application.WorksheetFunction.VLookup("Apps", ActiveSheet.[A:B], 2, False)
    colSales_com = Application.WorksheetFunction.VLookup("Sales Comm", ActiveSheet.[A:B], 2, False)
    colAgent_com = Application.WorksheetFunction.VLookup("Agent Comm", ActiveSheet.[A:B], 2, False)
    colTot_com = Application.WorksheetFunction.VLookup("Total Comm", ActiveSheet.[A:B], 2, False)
    colTot_transp = Application.WorksheetFunction.VLookup("Total Transp", ActiveSheet.[A:B], 2, False)
    colOther = Application.WorksheetFunction.VLookup("Other", ActiveSheet.[A:B], 2, False)
    colCM = Application.WorksheetFunction.VLookup("CM", ActiveSheet.[A:B], 2, False)
    colCM_pct = Application.WorksheetFunction.VLookup("CM %", ActiveSheet.[A:B], 2, False)
    colpct_dis = Application.WorksheetFunction.VLookup("% Discount", ActiveSheet.[A:B], 2, False)
    colmmcmimpact = Application.WorksheetFunction.VLookup("MMCM Impact", ActiveSheet.[A:B], 2, False)
    colservice_flag = Application.WorksheetFunction.VLookup("Service Contract Flag", ActiveSheet.[A:B], 2, False)
    colservice_price = Application.WorksheetFunction.VLookup("Service Price USD", ActiveSheet.[A:B], 2, False)
    colservice_name = Application.WorksheetFunction.VLookup("Service Coverage", ActiveSheet.[A:B], 2, False)
    colcnt_warr = Application.WorksheetFunction.VLookup("Contract or Warranty", ActiveSheet.[A:B], 2, False)
    colSeg = Application.WorksheetFunction.VLookup("Segment", ActiveSheet.[A:B], 2, False)
    colEquip = Application.WorksheetFunction.VLookup("Equipment/Svc", ActiveSheet.[A:B], 2, False)
 
    'Gèle l'écran pendant l'exécution
    Application.ScreenUpdating = False
 
    'Application.Calculation = xlCalculationManual
 
    'on colle les colonnes du PPR dans la feuille
    Workbooks(ppr).Sheets(tmp).Activate
 
    'regrouper toutes les colonnes non consécutive pour copier une seule fois avec la méthode Union
    'la méthode Union a une limite de 30 arguments
     With Sheets(tmp)
          Union(.Columns(colquote_num), .Columns(colopp_num), .Columns(colacc_name), .Columns(colyea), .Columns(colq), _
                .Columns(colfw), .Columns(colpole), .Columns(colregion), .Columns(colpays), .Columns(colge_mod), _
                .Columns(colcp), .Columns(colqty), .Columns(coltot_equip_lp), .Columns(colaop), .Columns(colsp_net), _
                .Columns(colTI), .Columns(colNESP), .Columns(colicv), .Columns(colNLs), .Columns(colinstall), _
                .Columns(colwty), .Columns(colFMI), .Columns(colApps), .Columns(colSales_com), .Columns(colAgent_com), _
                .Columns(colTot_com), .Columns(colTot_transp), .Columns(colOther), .Columns(colCM), .Columns(colCM_pct)).Copy
     End With
 
    Workbooks(extract).Sheets(2).Activate
    Cells(1, 1).PasteSpecial Paste:=xlValues
 
    'rajout service/occr
     Workbooks(ppr).Sheets(tmp).Activate
 
    With Sheets(tmp)
         Union(.Columns(colpct_dis), .Columns(colEquip), .Columns(colmmcmimpact), .Columns(colservice_flag), _
               .Columns(colservice_price), .Columns(colservice_name), .Columns(colcnt_warr), .Columns(colSeg)).Copy
    End With
 
    Workbooks(extract).Sheets(2).Activate
    Cells(1, 31).PasteSpecial Paste:=xlValues
    'fin rajout
 
    'calcul nbre de lines fichiers
     nbrelines = Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
    'enleve les date vide et services
    For t = nbrelines To 2 Step -1
        With Sheets(2)
            If .Cells(t, "D") = "" Or .Cells(t, "AF") Or .Cells(t, "N") = 0 = "Services" Then .Rows(t).Delete
        End If
    Next t
 
    'calcul nbre de lines fichiers
     nbrelines = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
    'Calcul les bonnes données
     For t = 2 To nbrelines Step 1
 
        '----------------------------------------
        '            Données orders
        '----------------------------------------
 
        'Year
        Sheets(1).Cells(t, "A") = Left(Sheets(2).Cells(t, "D"), 4)
        'Quarter
        Sheets(1).Cells(t, "B") = Sheets(1).Cells(t, "A") & " Q" & Sheets(2).Cells(t, "E")
        'FW
        If Len(Sheets(2).Cells(t, "F")) > 1 Then
            Sheets(1).Cells(t, "C") = Sheets(1).Cells(t, "A") & " FW" & Sheets(2).Cells(t, "F")
        Else
            Sheets(1).Cells(t, "C") = Sheets(1).Cells(t, "A") & " FW0" & Sheets(2).Cells(t, "F")
        End If
 
        'Moved to EOB = order date
        Sheets(1).Cells(t, "D") = ""
        'Customer name
        Sheets(1).Cells(t, "E") = Sheets(2).Cells(t, "C")
        'Pole
        Sheets(1).Cells(t, "F") = Sheets(2).Cells(t, "G")
        'Region
        Sheets(1).Cells(t, "G") = Sheets(2).Cells(t, "H")
        'Ship to country
        Sheets(1).Cells(t, "H") = Sheets(2).Cells(t, "I")
        'PSI Modality desc
        Sheets(1).Cells(t, "I") = Sheets(2).Cells(t, "J")
        'Product name
        Sheets(1).Cells(t, "K") = Sheets(2).Cells(t, "K")
        'PSI name = Product_name (pour l'instant)
        Sheets(1).Cells(t, "J") = Sheets(1).Cells(t, "K")
        'Order status
        Sheets(1).Cells(t, "L") = ""
        'Purchase order
        Sheets(1).Cells(t, "M") = ""
        'equote order no
        Sheets(1).Cells(t, "N") = Sheets(2).Cells(t, "A")
        'force id
        Sheets(1).Cells(t, "O") = Sheets(2).Cells(t, "B")
        'psi qty
        Sheets(1).Cells(t, "P") = Sheets(2).Cells(t, "L")
 
        'list price
        'Si % Discount <= 0 ou >= 0.999
        If Sheets(2).Cells(t, "AE") <= 0 Or 0.999 <= Sheets(2).Cells(t, "AE") Then
        'alors list price = equip_revenue_usd à savoir equip_revenue_usd = NESP * 1000
            Sheets(1).Cells(t, "Q") = Sheets(2).Cells(t, "Q") * 1000
        'sinon list price = NESP * 1000 / (1 - % Discount)
        Else
            Sheets(1).Cells(t, "Q") = Sheets(2).Cells(t, "Q") * 1000 / (1 - Sheets(2).Cells(t, "AE"))
        End If
 
        'contract amount = net_selling_price_usd à savoir net_selling_price_usd = SP Net total * 1000
        Sheets(1).Cells(t, "R") = Sheets(2).Cells(t, "O") * 1000
        'neov = equip_revenue_usd
        Sheets(1).Cells(t, "S") = Sheets(2).Cells(t, "Q") * 1000
        'tradein amount = TI * 1000
        Sheets(1).Cells(t, "T") = Sheets(2).Cells(t, "P") * 1000
        'total discount = % discount * list price
        Sheets(1).Cells(t, "U") = Sheets(2).Cells(t, "AE") * Sheets(1).Cells(t, "Q")
        'occr amount
        Sheets(1).Cells(t, "V") = Sheets(2).Cells(t, "AG") * 1000
        'discount %
        Sheets(1).Cells(t, "W") = Sheets(2).Cells(t, "AE")
        'nl cost = NLs * 1000
        Sheets(1).Cells(t, "X") = Sheets(2).Cells(t, "S") * 1000
        'mm icv = ICV * 1000
        Sheets(1).Cells(t, "Y") = Sheets(2).Cells(t, "R") * 1000
        'sm pricing = equip_revenue_usd - NL Cost - MM ICV
        Sheets(1).Cells(t, "Z") = Sheets(2).Cells(t, "Q") * 1000 - Sheets(1).Cells(t, "X") - Sheets(1).Cells(t, "Y")
        'sm pricing % = sm pricing / equip_revenue_usd
        Sheets(1).Cells(t, "AA") = Sheets(1).Cells(t, "Z") / (Sheets(2).Cells(t, "Q") * 1000)
        'freight = total transp * 1000
        Sheets(1).Cells(t, "AB") = Sheets(2).Cells(t, "AA") * 1000
        'warranty = wty * 1000
        Sheets(1).Cells(t, "AC") = Sheets(2).Cells(t, "U") * 1000
        'installation
        Sheets(1).Cells(t, "AD") = Sheets(2).Cells(t, "T") * 1000
        'sales commision usd = sales comm * 1000
        Sheets(1).Cells(t, "AE") = Sheets(2).Cells(t, "X") * 1000
        'agent commision
        Sheets(1).Cells(t, "AF") = Sheets(2).Cells(t, "Y")
        'fmi = FMI * 1000
        Sheets(1).Cells(t, "AG") = Sheets(2).Cells(t, "V") * 1000
        'clinical apps = Apps * 1000
        Sheets(1).Cells(t, "AH") = Sheets(2).Cells(t, "W") * 1000
        'other ovc = other * 1000
        Sheets(1).Cells(t, "AI") = Sheets(2).Cells(t, "AB") * 1000
        'cm = CM * 1000
        Sheets(1).Cells(t, "AJ") = Sheets(2).Cells(t, "AC") * 1000
        'cm %
        Sheets(1).Cells(t, "AK") = Sheets(2).Cells(t, "AD")
        'target = neov - (vtgt aop * 1000)
        'pour l'instant, vtgt aop = 0
        Sheets(1).Cells(t, "AL") = Sheets(1).Cells(t, "S")
        'v target = vtgt aop * 1000
        'pour l'instant, v target = 0
        Sheets(1).Cells(t, "AM") = "0"
        'aop op = neov / psi qty - vop aop * 1000
        'pour l'instant, vop aop = 0
        Sheets(1).Cells(t, "AN") = Sheets(1).Cells(t, "S") / Sheets(1).Cells(t, "P")
        'aop = neov / psi qty
        Sheets(1).Cells(t, "AO") = Sheets(1).Cells(t, "S") / Sheets(1).Cells(t, "P")
        'v op = vop aop * 1000
        'pour l'instant, vop = 0
        Sheets(1).Cells(t, "AP") = "0"
        'wf list price =  list price
        Sheets(1).Cells(t, "AQ") = Sheets(1).Cells(t, "Q")
        'wf discount = total discount * -1
        Sheets(1).Cells(t, "AR") = Sheets(1).Cells(t, "U") * -1
        'wf net price = wf list price + wf discount
        Sheets(1).Cells(t, "AS") = Sheets(1).Cells(t, "AQ") + Sheets(1).Cells(t, "AR")
        'wf ge icv = mm icv * -1
        Sheets(1).Cells(t, "AT") = Sheets(1).Cells(t, "Y") * -1
        'wf nl cost = nl cost * -1
        Sheets(1).Cells(t, "AU") = Sheets(1).Cells(t, "X") * -1
        'wf sm pricing = sm pricing
        Sheets(1).Cells(t, "AV") = Sheets(1).Cells(t, "Z")
        'wf freight = freight * -1
        Sheets(1).Cells(t, "AW") = Sheets(1).Cells(t, "AB") * -1
        'wf sm = wf sm pricing + wf freight
        Sheets(1).Cells(t, "AX") = Sheets(1).Cells(t, "AV") + Sheets(1).Cells(t, "AW")
        'wf warranty = warranty * -1
        Sheets(1).Cells(t, "AY") = Sheets(1).Cells(t, "AC") * -1
        'wf installation = installation * -1
        Sheets(1).Cells(t, "AZ") = Sheets(1).Cells(t, "AD") * -1
        'wf sales commision = sales comm * -1
        Sheets(1).Cells(t, "BA") = Sheets(1).Cells(t, "AE") * -1
        'wf agent commision = agent comm * -1
        Sheets(1).Cells(t, "BB") = Sheets(1).Cells(t, "AF") * -1
        'wf fmi = FMI * -1
        Sheets(1).Cells(t, "BC") = Sheets(1).Cells(t, "AG") * -1
        'wf clinical apps = clinical apps * -1
        Sheets(1).Cells(t, "BD") = Sheets(1).Cells(t, "AH") * -1
        'wf other ovc = other ovc * -1
        Sheets(1).Cells(t, "BE") = Sheets(1).Cells(t, "AI") * -1
        'wf estimated cm = CM
        Sheets(1).Cells(t, "BF") = Sheets(1).Cells(t, "AJ")
        'wf occr amt = occr amount * -1
        Sheets(1).Cells(t, "BG") = Sheets(1).Cells(t, "V") * -1
        'wf estimated cm w/o occr amt = wf estimated cm + wf occr amt
        Sheets(1).Cells(t, "BH") = Sheets(1).Cells(t, "BF") + Sheets(1).Cells(t, "BG")
 
        '--------------------------------------
        '          Données services
        '--------------------------------------
 
        'Service requested flag
        Sheets(1).Cells(t, "BI") = Sheets(2).Cells(t, "AL")
 
        'Service Price
        Sheets(1).Cells(t, "BJ") = Sheets(2).Cells(t, "AI")
 
        'Service Contract Offering
        'Mappage avec vlookup
        On Error Resume Next
 
        Sheets(1).Cells(t, "BK") = Application.WorksheetFunction.VLookup(Sheets(2).Cells(t, "AJ"), _
                                   Workbooks(ppr).Sheets("parametre").[BC:BD], 2, False)
 
        If Err.Number > 0 Then Sheets(1).Cells(t, "BK") = ""
 
        'Service target price
        Sheets(1).Cells(t, "BL") = 0
 
        'V Target service (%)
        'v target price % = service price % - service target price %
        Sheets(1).Cells(t, "BM") = 0
 
        'V Target service ($)
        'v target price $ = service price $ - service target price $
        Sheets(1).Cells(t, "BN") = 0
 
        'Contract type (Contract/Warranty/Both)
        Sheets(1).Cells(t, "BO") = Sheets(2).Cells(t, "AH")
 
        'Mappage
        Select Case Sheets(1).Cells(t, "BO")
            Case "B"
                Sheets(1).Cells(t, "BO") = "Both"
            Case "C"
                Sheets(1).Cells(t, "BO") = "Contract"
            Case "W"
                Sheets(1).Cells(t, "BO") = "Warranty"
            Case "N"
                Sheets(1).Cells(t, "BO") = "No"
        End Select
 
        'Segmentation
        Sheets(1).Cells(t, "BP") = Sheets(2).Cells(t, "AK")
 
        'Si % Discount <= 0 ou >= 1
         If Sheets(1).Cells(t, "W") <= 0 Or 1 <= Sheets(1).Cells(t, "W") Then
            'alors total discount = 0, wf discount = 0, wf net price = wf list price, % discount = 0
             Sheets(1).Cells(t, "U") = 0
             Sheets(1).Cells(t, "AR") = 0
             Sheets(1).Cells(t, "AS") = Sheets(1).Cells(t, "AQ")
             Sheets(1).Cells(t, "W") = 0
         End If
    Next
    Sheets(1).Activate
Else
    MsgBox "Annulé !"
End If
    'Réactiver l'écran
    Application.ScreenUpdating = True
    'Application.Calculation = xlCalculationAutomatic
End Sub

Pas sûr d'avoir compris les 68 colonnes, mais bon...
Tu fais plusieurs fois la même boucle, sans raison. autant profiter de la boucle pour faire tout ce qui concerne la ligne, plutôt que de refaire les 12000 lignes une seconde fois.

L'utilisation de WorksheetFunction n'est pas forcément la meilleure chose à faire, mais comme je ne connais pas les données...
A+

[Didier Gonard]

Bonjour,

effectivement , sur un tableau perso de 14 millions de cellules, le fait de concaténer à chaque cellule une série de 2 caractères me prend 1h et 14 minutes avec un for each sur la collection de cellules...

Si je passe par des Array (variable tableau) ça prend 1 minute et 41 secondes…

sur l'exemple de ce fil :

http://www.developpez.net/forums/d91...ion-dynamique/

le code met 6,0468 secondes pour s'exécuter sur 311 000 cellules.

à voir : Utiliser les variables tableaux en VBA Excel

et sur le fil sus-nommé les transferts feuil / tableau et inverse direct + le timer...

cordialement,

Didier

[hantran]

Bonjour,

Après un long weekend je me plonge à nouveau dans mes macros hummm miam miam

Merci laetitia et neupont, j'ai réécrit la macro en utilisant un tableau, le temps d'exécution a diminué plus de moitié, au dernier record : 24 secondes ! maintenant. Aller, on peut faire mieux

Salut Gorfael, j'ai pas trop compris ton message, j'ai bien fait les traitements ligne par ligne. Où est-ce que t'as vu que j'ai fait les 12000 lignes une seconde fois ? Si tu peux m'éclaircir un peu plus...

Je vais essayer d'enlever tous les Select, Activate, comme ce qu'a souligné mercatog pour voir

Je vous tiendrai au courant, merci pour votre aide

[Minick]

Salut,

200000 calculs en 56 secondes je trouve ca pas si mal que ca.

Mais ca depend de beaucoup de chose, entre autre de la puissance de la machine, et du type de calcul effectue...


Pour comparaison, j'ai fais une simple addition n°ligne + n°colonne j'arrve a 45s
sur un portable (2.4ghz dual, 3go)

[hantran]

j'ai publié le code au dessus au cas où vous n'avez pas remarqué

c'est une macro qui fait dans un premier temps un copier/coller tout bêtement des colonnes dans Sheet2, et puis refaire des bon calculs dans Sheet1. Au final ça donne un fichier de 17Mb.

c'est un fichier à créer une fois par semaine, ça va encore, c'est juste parce que je suis perfectionnist (lol) que je voudrais l'améliorer.

je cherche aussi un moyen pour réduire la taille du fichier, récemment j'ai réussi à gagner 6Mb

[mercatog]

tu peux t'en passer des Select et activate
tu peux souvent traiter une cellule sans la sélectionner (en mettant la référence complète)
Par exemple au lieu de

Code :

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

1
2
3
sheets(1).activate
range("A1").select
selection.copy

tu mets

Code :

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

sheets(1).range("A1").copy

[laetitia]

re,tous effectivement c'est du lourd!!! il faudrait ecrire tous cela en passant par des " tablos" avec redim preserve ect...beaucoup plus rapide pas trop le temps de regarder fait une recherche sur le forum
dans un premier temps tu peus rajouter DisplayAlerts
debut de ton code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
 
'ton code
 
ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With

[neupont]

Si (et seulement si) ta macro modifie beaucoup de cellules (plusieurs milliers disons), tu pourrais sans doute gagner beaucoup de temps en appliquant tes calculs non pas directement dans les cellules mais dans un tableau de variables qui en serait l'image. Dans un deuxième temps il suffit ensuite de "plaquer" le tableau sur la feuille.

Il faut bien voir que c'est surtout le temps d'écriture dans la cellule qui vaut cher, et pas le temps de lecture (ni le temps d'écriture dans un tableau).
Pour ma part j'ai récemment divisé par 10 un temps de traitement en faisant comme ça, mais il te faut maîtriser les tableaux de variables (pas bien sorcier).

Un exemple simple (dans ton cas ce sera un tout autre challenge ) :

L'idée est qu'un tableau a deux dimensions correspond à une plage d'une feuille excel (la 1ère dimension pour les lignes, la seconde pour les colonnes)
Par exemple ce tableau :
Dim tab(1 to 3, 1 to 5) as variant
correspond à une plage de 3 lignes et 5 colonnes. Si cette plage commence en A1, la cellule C2 aura pour équivalent tab(2,3). Ceci dit la plage peut commencer sur n'importe quelle cellule ça ne change rien pour le tableau, c'est quand on l'affectera à la plage qu'il faudra préciser celle-ci.

Il faut impérativement que le tableau ait exactement la même taille que la plage à traiter.
Quand on ne connaît pas au début du code les dimensions à affecter au tableau, il faut le déclarer sans dimensions et le redéfinir avec ReDim une fois qu'on a calculé la taille de la plage qu'il est censé représenter.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim monTableau() As variant 'je déclare mon tableau
'ici il faudrait calculer les dimensions de la plage qui a disons 10 lignes et 5 colonnes... je passe.
'je redimensionne mon tableau : 
ReDim monTableau(1 to 10, 1 to 5) as variant
 
' au lieu de travailler dans la cellule comme ici :
'Sheets(1).Cells(t, "A") = Left(Sheets(2).Cells(t, "D"), 4)
'je travaille dans mon tableau :
monTableau(t,1) = Left(Sheets(2).Cells(t, "D"), 4) 'je rappelle que la lecture dans une cellule n'est pas gourmande en temps par contre
 
'etc... 
'Puis à la fin je plaque mon tableau sur ma feuille, peut importe l'emplacement de la plage mais elle doit avoir exactement les dimensions du tableau, et là ça va très vite par contre :
Sheets(f).Range("A1:E10") = monTableau

Je raconte mal, hein ?

[Gorfael]

Salut hantran et le forum

Le trouvez-vous long ?

Çafait de l'ordre de 80µs/cellule. Comme on ne sait pas ce que fait ta macro, ça ne me semble pas très long.

Y-a-t-il d'autre moyen pour le réduire encore plus ?

Limiter le nombre de cellules qui subissent le traitement. Consacrer toutes les ressources du micro à Excel.
Mettre le code sur un poste, qu'on puisse l'optimiser ?
A+