Temps execution macro

Version imprimable

Bonjour,

Voila j'ai écrit une macro pour faire un calcul de moyenne. Celle fonctionne avec un test à 100 ligne ou 1000 au delà elle tourne sans s'arreter.

Meme avec XLcalutionmanual et Screenupdating=false je ne gagne pas mieux en execution

Quelqu'un pourrait m'aider à la transformer pour gagner en temps d'execution?
Code:

1 2 3 4 5 6 7 8 For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 .Cells(i, 149).FormulaArray = "=AVERAGE(IF((R2C72:R37030C72=RC[-77])*(R2C74:R37030C74=RC[-75])>0,R2C86:R37030C86))" .Cells(i, 147).FormulaArray = "=IF(RC[-65]<>"""",AVERAGE(IF((R2C72:R37030C72=RC[-75])*(R2C74:R37030C74=RC[-73])>0,R2C82:R37030C82)),"""")" .Cells(i, 148).FormulaArray = "=AVERAGE(IF((R2C72:R37030C72=RC[-76])*(R2C74:R37030C74=RC[-74])>0,R2C84:R37030C84))" Next i
Merci

Si tu veux être plus rapide tu devrais tout mettre dans des tableaux, travailler dessus et tout recracher dans les cellules.

Code:

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
 
'...
    While Sheets("E").Cells(i, j).Value <> ""
        tableau(2, x) = Sheets("E").Cells(i, j).Value
        tableau(3, x) = Sheets("E").Cells(i, j + 1).Value
        tableau(4, x) = Sheets("E").Cells(i, j + 2).Value
        tableau(5, x) = Sheets("E").Cells(i, j + 3).Value
        tableau(6, x) = Sheets("E").Cells(i, j + 4).Value
        x = x + 1
        i = i + 1
    Wend
'...
'ton calcul de moyenne
'...
 
 
For i = 1 To NBR
    Sheets("L").Cells(i, 2).Value = tableau(1, i)
    Sheets("L").Cells(i, 3).Value = tableau(2, i)
    Sheets("L").Cells(i, 4).Value = tableau(3, i)
    Sheets("L").Cells(i, 5).Value = tableau(4, i)
    Sheets("L").Cells(i, 6).Value = tableau(5, i)
    Sheets("L").Cells(i, 7).Value = tableau(6, i)
Next i
'....

J'ai essayé avec cette solution
çà fonctionne sauf que la validation de formule (ctrl+maj+entree) n'est pas prise en compte

Code:

1
2
3
4
5
6
7
 
 
         dern = Sheets("extraction").Range("A65536").End(xlUp).Row
        .Range("ES2").FormulaArray = "=AVERAGE(IF((R2C72:R37030C72=RC[-77])*(R2C74:R37030C74=RC[-75])>0,R2C86:R37030C86))" 'timeliness ra
        .Range("ES2").Copy
        .Range("ES3:ES" & dern).Select
        Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Quelqu'un peut m'aider?

Bonjour,

Essaie comme ça je pense que ce sera plus rapide:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
 
     Dim Destination as Range
     Dim lastLigne as Long
     '.....
     '.....
     With taFeuille
 
        lastLigne = .Cells(Application.Rows.Count, 1).End(xlUp).Row
 
        .Cells(2, 147).FormulaArray = "=IF(RC[-65]<>"""",AVERAGE(IF((R2C72:R37030C72=RC[-75])*(R2C74:R37030C74=RC[-73])>0,R2C82:R37030C82)),"""")"
        .Cells(2, 148).FormulaArray = "=AVERAGE(IF((R2C72:R37030C72=RC[-76])*(R2C74:R37030C74=RC[-74])>0,R2C84:R37030C84))"
        .Cells(2, 149).FormulaArray = "=AVERAGE(IF((R2C72:R37030C72=RC[-77])*(R2C74:R37030C74=RC[-75])>0,R2C86:R37030C86))"
 
        Set Destination = .Range(.Cells(2, 147), .Cells(lastLigne, 149))
        .Range(.Cells(2, 147), .Cells(2, 149)).AutoFill Destination:=Destination
 
    End With
 
End Sub

Bonne journée.

15/02/2013, 12h10
ninette24

Merci beaucoup çà fonctionne ;-)