Codage Array - Accélération éxécution

Bonjour.

Tu peux effectivement sauver de précieuses mili-secondes en limitant le
nombre de lecture de la feuille. Compare les 2 procédures Test1 et Test2
pour t'en convaincre.

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub test1()

Dim t2 As Long

t2 = timeGetTime()

endrow = 2000
Dim curMM3 As Currency
Dim curMM20 As Currency
Dim a As Variant
Dim a40 As Variant
a40 = Range("a1:a" & endrow)

For i = 40 To endrow
If a40(i - 1, 1) <> "" Then
curMM3 = Application.WorksheetFunction.Average((Range(Cells(i - 1, 5),
Cells(i - 3, 5))))
curMM20 = Application.WorksheetFunction.Average((Range(Cells(i, 5),
Cells(i - 19, 5))))

End If
Next i
t2 = timeGetTime() - t2
MsgBox t2 & " mili-secondes"
End Sub

Sub test2()
Dim t2 As Long

t2 = timeGetTime()
endrow = 2000
Dim curMM3 As Currency
Dim curMM20 As Currency
For i = 40 To endrow
If Cells(i - 1, 1).Value <> "" Then
curMM3 = Application.WorksheetFunction.Average((Range(Cells(i - 1, 5),
Cells(i - 3, 5))))
curMM20 = Application.WorksheetFunction.Average((Range(Cells(i, 5),
Cells(i - 19, 5))))
End If
Next i
t2 = timeGetTime() - t2
MsgBox t2 & " mili-secondes"

End Sub

docm


"YannL" <YannL@discussions.microsoft.com> wrote in message
news:90476862-C82F-4840-B525-3A92D6B33FB2@microsoft.com...

Bonjour,

Un problème probablement trivial pour lequel je ne trouve pas la réponse.
J'ai écrit un code en faisant référence à des cellules, puis ai voulu le
transformer avec des array afin d'accélérer l'exécution. Théoriquement pas
de

problème, mais pratiquement, blocage avec toujours le même message d'
erreur

et problème visiblement d'identification/calcul du Range.
Il s'agit d'un calcul de moyennes mobiles, indicateur courant en économie.


Code initial
endrow = 2000
Dim curMM3 As Currency
Dim curMM20 As Currency
For i = 40 To endrow
If Cells(i - 1, 1).Value <> "" Then
curMM3 = Application.WorksheetFunction.Average((Range(Cells(i - 1, 5),
Cells(i - 3, 5))))
curMM20 = Application.WorksheetFunction.Average((Range(Cells(i, 5),
Cells(i

- 19, 5))))
End If
Next i

Code avec Array
endrow = 2000
Dim A_ValeurEnter As Variant
Dim curMM3 As Currency
Dim curMM20 As Currency
A_ValeurEnter = Sheets("Data").Range(Cells(4, 5), Cells(endrow, 5)).Value
For i = 40 To endrow
If A_ValeurEnter(i - 1, 1) <> "" Then
curMM3 = Application.WorksheetFunction.Average((Range(A_ValeurEnter(i - 1,
1), A_ValeurEnter(i - 3, 1))))
curMM20 = Application.WorksheetFunction.Average((Range(A_ValeurEnter(i,
1),

A_ValeurEnter(i - 19, 1))))
End If
Next i

Merci.

Yann