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
| Public Declare Function GetTickCount& Lib "kernel32" ()
Dim rng As Excel.Range
Dim Montab(1 To 3, 1 To 1) As Double
'***************************************************************************
'*************** Procédure principale *************************************
'***************************************************************************
Sub subChronoCompare()
Dim d As Long, dT As Long, dA As Long, dB As Long
Dim sDT As Single, sDA As Single, sDB As Single, sMax As Single
Dim start As Long
Dim l As Long
Dim n As Long, nT As Long, nA As Long, nB As Long
Dim mT As Long, mA As Long, mB As Long, Bou As Long
Dim Message As String
Const ChMini As Long = 128
Set rng = Application.ThisWorkbook.Sheets(1).Range("A1:A3")
Montab(2, 1) = 245.7894321 'ces mêms valeurs sont inscrites en feuilles(1).A2
Montab(3, 1) = 123456.789 'et .A3
'recherche d'une valeur nA, par octave, donnant un chrono > chMini ms
d = 0
n = 1
While d < ChMini
start = GetTickCount&
Call subAppelSub1(n)
d = GetTickCount& - start
n = n * 2
Wend
dA = d
nA = n / 2
'recherche nB
d = 0
n = 1
While d < ChMini
start = GetTickCount&
Call subAppelSub2(n)
d = GetTickCount& - start
n = n * 2
Wend
dB = d
nB = n / 2
'vérification : la durée élémentaire ne doit pas dépasser 1s.
If dA / nA > 1000 Then Message = "La procédure 1 a un temps d'exécution supérieur à 1 s." & vbCrLf
If dB / nB > 1000 Then Message = Message & "La procédure 2 a un temps d'exécution supérieur à 1 s."
If Message <> "" Then MsgBox Message: Exit Sub
'recherche NT
d = 0
n = 1
While d < ChMini
start = GetTickCount&
Call subAppelTemoin(n)
d = GetTickCount& - start
n = n * 2
Wend
dT = d
nT = n / 2
'calcul du nombre d'itérations élémentaires pour témoin, sub1 et sub2; calcul du nombre d'itérations commun (Bou)
If dA / nA > dB / nB Then
mA = Round(nA * ChMini / dA, 0)
If mA = 0 Then mA = 1
sMax = mA * dA / nA
mB = Round(sMax / dB * nB, 0)
mT = Round(sMax / dT * nT, 0)
Bou = Round(5000 / sMax, 0)
Else
mB = Round(nB * ChMini / dB, 0)
If mB = 0 Then mB = 1
sMax = mB * dB / nB
mA = Round(sMax / dA * nA, 0)
mT = Round(sMax / dT * nT, 0)
Bou = Round(5000 / sMax, 0)
End If
'chronométrage entrelacé
dT = 0: dA = 0: dB = 0
For l = 1 To Bou
start = GetTickCount&
Call subAppelTemoin(mT)
dT = dT + GetTickCount& - start
start = GetTickCount&
Call subAppelSub1(mA)
dA = dA + GetTickCount& - start
start = GetTickCount&
Call subAppelSub2(mB)
dB = dB + GetTickCount& - start
Next l
'calculs des durées unitaires
sDT = dT / Bou / mT
sDA = dA / Bou / mA - sDT
sDB = dB / Bou / mB - sDT
MsgBox "Temps moyens corrigés." & vbCrLf & "Proc 1 : " & Format(sDA * 1000, "#,##0.0"" µs""") & _
vbCrLf & "Proc 2 : " & Format(sDB * 1000, "#,##0.0"" µs""") & vbCrLf & "Ratio P1/P2 : " & Format(sDA / sDB, "#,##0.0")
End Sub
'***************************************************************************
'*************** Procédures d'itération niveau intermédiaire ***************
'***************************************************************************
Private Sub subAppelTemoin(ByVal Iter As Long)
Dim i As Long
For i = 1 To Iter
Call subTemoin
Next i
End Sub
Private Sub subAppelSub1(ByVal Iter As Long)
Dim i As Long
For i = 1 To Iter
Call sub1 'placer ici la procédure 1 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
Private Sub subAppelSub2(ByVal Iter As Long)
Dim i As Long
For i = 1 To Iter
Call sub2 'placer ici la procédure 2 à appeler ou placer le code dans la procédure de ce nom
Next i
End Sub
'***************************************************************************
'********* procédures élémentaires contenant le code à mesurer *************
'***************************************************************************
Sub subTemoin()
'procédure laissée intentionnellement vide
End Sub
Sub sub1()
rng(1, 1) = rng(2, 1) + rng(3, 1)
End Sub
Sub sub2()
Montab(1, 1) = Montab(2, 1) + Montab(3, 1)
End Sub |
Partager