Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel [HS] Tester vitesse d'exécution de deux macros

[HS] Tester vitesse d'exécution de deux macros

34 réponses
Avatar
Tatanka
Bonsoir, Bonsoir,

Auriez-vous la bonté de faire exécuter mes deux macros
et me retourner le temps requis par vos machines pour les
exécuter en me spécifiant quelques caractéristiques de votre ordi.
C'est que j'aimerais comparer vos résultats avec ceux
obtenus sur un ordi qu'un ami veut me vendre.
http://cjoint.com/?ebtKXK4L4f
http://cjoint.com/?ebtLBv55qQ

Merci

A --

Serge, en quête de vitesse ;-)
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3 4
Avatar
Tatanka
Et bien, merci à toi aussi.
Patrick le patient a essayé Keith pour n de 10 à 999 999 999
Il en a trouvé 41 et c'est tout bon.
Temps requis : 16h 37m 57s !!!
Et inutile d'essayer pour n de 999 999 999 à 9 999 999 999 ;-)
car il n'y a pas de nombre de Keith à 10 chiffres !

Serge


"Pounet95" a écrit dans le message de news: %
Bonjour,
Suis à la traîne, mais j'apporte mapieere à l'édifice.
Keith : 10 s
Fractales : 13 s
Processeur Intel Core Q6600 2048 Mo Vista Edition Familiale Excel 2007
Indice perf windows ( j'sais pas comment c'est calculé ! ) : 3,8

Bon choix
Pounet95

"Tatanka" a écrit dans le message de news:
Bonsoir, Bonsoir,

Auriez-vous la bonté de faire exécuter mes deux macros
et me retourner le temps requis par vos machines pour les
exécuter en me spécifiant quelques caractéristiques de votre ordi.
C'est que j'aimerais comparer vos résultats avec ceux
obtenus sur un ordi qu'un ami veut me vendre.
http://cjoint.com/?ebtKXK4L4f
http://cjoint.com/?ebtLBv55qQ

Merci

A --

Serge, en quête de vitesse ;-)










Avatar
Patrick BASTARD
Bonjour, *Tatanka*

Es-tu sûr de ton timer ?

J'ai lancé le calcul des 41 premiers vers 22h, et ai laissé lâchement
travailler la machine pendant que son maître pionçait (ma patience ne va pas
jusque là...).
Je t'ai envoyé le résultat ce matin vers 8h30, mais sans savoir quand le
travail s'est réellement terminé.
Cela fait donc un max de 10h30. Or le msgbox indiquait bien 16h 37m 57s.
Penses-tu que les heures de nuit comptent double ?
;-)

--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.



Et bien, merci à toi aussi.
Patrick le patient a essayé Keith pour n de 10 à 999 999 999
Il en a trouvé 41 et c'est tout bon.
Temps requis : 16h 37m 57s !!!
Et inutile d'essayer pour n de 999 999 999 à 9 999 999 999 ;-)
car il n'y a pas de nombre de Keith à 10 chiffres !

Serge


"Pounet95" a écrit dans le message de news:
%
Bonjour,
Suis à la traîne, mais j'apporte mapieere à l'édifice.
Keith : 10 s
Fractales : 13 s
Processeur Intel Core Q6600 2048 Mo Vista Edition Familiale
Excel 2007 Indice perf windows ( j'sais pas comment c'est calculé ! ) :
3,8

Bon choix
Pounet95

"Tatanka" a écrit dans le message de
news:
Bonsoir, Bonsoir,

Auriez-vous la bonté de faire exécuter mes deux macros
et me retourner le temps requis par vos machines pour les
exécuter en me spécifiant quelques caractéristiques de votre ordi.
C'est que j'aimerais comparer vos résultats avec ceux
obtenus sur un ordi qu'un ami veut me vendre.
http://cjoint.com/?ebtKXK4L4f
http://cjoint.com/?ebtLBv55qQ

Merci

A --

Serge, en quête de vitesse ;-)






Avatar
PMO
Bonjour,

Au sujet des fractales et de votre quête de vitesse

En ayant optimisé votre code, j'obtiens un gain de temps significatif.
Avec ma machine processeur Core 2 Duo 2.33 GHz
j'obtiens 17s/18s avec votre code et 6s/7s avec le code modifié.

Voici le code que j'ai modifié
'*****************
'### Constantes à adapter ###
Const LIG_MAX As Long = 510
Const COL_MAX As Long = 255
'############################
'__________________
Sub PMO_Cellules_Fractales()
Dim Couleurs%()
Dim i&
Dim j&
Dim k&
Dim t1 As Date
Dim R As Range
t1 = Time
Dim index%(1 To LIG_MAX, 1 To COL_MAX)
Dim myTab(LIG_MAX * COL_MAX)
For i& = 1 To LIG_MAX
For j& = 1 To COL_MAX
k& = k& + 1
myTab(k&) = Abs((i& Imp j&) Or (i& + Not (j&))) Mod 56
index%(i&, j&) = myTab(k&)
Next j&
Next i&
Call algoTri(LBound(myTab), UBound(myTab), myTab)
k& = 0
For i& = 1 To UBound(myTab)
If i& = 1 Then
k& = k& + 1
ReDim Preserve Couleurs(1 To k&)
Couleurs(k&) = myTab(i&)
Else
If myTab(i&) <> myTab(i& - 1) Then
k& = k& + 1
ReDim Preserve Couleurs(1 To k&)
Couleurs(k&) = myTab(i&)
End If
End If
Next i&
Sheets.Add
Call Affichage
For i& = 1 To LIG_MAX
For k& = 1 To UBound(Couleurs)
For j& = 1 To COL_MAX
If index%(i&, j&) = Couleurs(k&) Then
If R Is Nothing Then
Set R = Range(Cells(i&, j&), Cells(i&, j&))
Else
Set R = Application.Union(R, Range(Cells(i&, j&), Cells(i&, j&)))
End If
End If
Next j&
If Not R Is Nothing Then
R.Interior.ColorIndex = Couleurs(k&)
Set R = Nothing
End If
Next k&
Next i&
MsgBox Format(Time - t1, "hh:mm:ss"), vbInformation, " Temps d'exécution"
End Sub
'__________________
Sub Affichage()
Cells.ColumnWidth = 0.33
Cells.RowHeight = 3.33
Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
End Sub
'__________________
Function algoTri(ByVal limiteinf&, ByVal limitesup&, ByRef tabtri() As
Variant)
Dim i&
Dim j&
Dim element
Dim transit
i& = limiteinf
j& = limitesup
transit = tabtri((limiteinf + limitesup) 2)
Do
Do While tabtri(i&) < transit
i& = i& + 1
Loop
Do While transit < tabtri(j&)
j& = j& - 1
Loop
If i& <= j& Then
element = tabtri(i&)
tabtri(i&) = tabtri(j&)
tabtri(j&) = element
i& = i& + 1
j& = j& - 1
End If
Loop Until i& > j&
If limiteinf < j& Then
Call algoTri(limiteinf, j&, tabtri())
End If
If i& < limitesup Then
Call algoTri(i&, limitesup, tabtri())
End If
End Function
'*****************

Avez-vous le même gain de temps ?

Cordialement.

PMO
Patrick Morange
Avatar
Modeste
Bonsour® PMO avec ferveur ;o))) vous nous disiez :

Au sujet des fractales et de votre quête de vitesse

En ayant optimisé votre code, j'obtiens un gain de temps significatif.
Avec ma machine processeur Core 2 Duo 2.33 GHz
j'obtiens 17s/18s avec votre code et 6s/7s avec le code modifié.
Avez-vous le même gain de temps ?


oui ;o)))
réduction d'un facteur 3

Windows XP x86 Family 15 Model 2 stepping 7 genuineIntel, 2606 MHz, Mem
Physique 512 Mo, Mem Virtuelle 2 Go
Excel 2002

Serge : 28/31s
Patrick : 10/11s
;o)))
réduite à 8s en appliquant judicieusement
un Application.ScreenUpdatingúlse
avant affichage ;o)))




--
--
@+
;o)))

Avatar
Tatanka
Salutations distinguées,

Super !
2,7 fois plus rapide.
Vais examiner ça attentivement en fin de semaine.

Serge
Si Misange essaie ta macro, elle aura le résultat instantanément ;-)


"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:

Bonjour,

Au sujet des fractales et de votre quête de vitesse

En ayant optimisé votre code, j'obtiens un gain de temps significatif.
Avec ma machine processeur Core 2 Duo 2.33 GHz
j'obtiens 17s/18s avec votre code et 6s/7s avec le code modifié.

Voici le code que j'ai modifié
'*****************
'### Constantes à adapter ###
Const LIG_MAX As Long = 510
Const COL_MAX As Long = 255
'############################
'__________________
Sub PMO_Cellules_Fractales()
Dim Couleurs%()
Dim i&
Dim j&
Dim k&
Dim t1 As Date
Dim R As Range
t1 = Time
Dim index%(1 To LIG_MAX, 1 To COL_MAX)
Dim myTab(LIG_MAX * COL_MAX)
For i& = 1 To LIG_MAX
For j& = 1 To COL_MAX
k& = k& + 1
myTab(k&) = Abs((i& Imp j&) Or (i& + Not (j&))) Mod 56
index%(i&, j&) = myTab(k&)
Next j&
Next i&
Call algoTri(LBound(myTab), UBound(myTab), myTab)
k& = 0
For i& = 1 To UBound(myTab)
If i& = 1 Then
k& = k& + 1
ReDim Preserve Couleurs(1 To k&)
Couleurs(k&) = myTab(i&)
Else
If myTab(i&) <> myTab(i& - 1) Then
k& = k& + 1
ReDim Preserve Couleurs(1 To k&)
Couleurs(k&) = myTab(i&)
End If
End If
Next i&
Sheets.Add
Call Affichage
For i& = 1 To LIG_MAX
For k& = 1 To UBound(Couleurs)
For j& = 1 To COL_MAX
If index%(i&, j&) = Couleurs(k&) Then
If R Is Nothing Then
Set R = Range(Cells(i&, j&), Cells(i&, j&))
Else
Set R = Application.Union(R, Range(Cells(i&, j&), Cells(i&, j&)))
End If
End If
Next j&
If Not R Is Nothing Then
R.Interior.ColorIndex = Couleurs(k&)
Set R = Nothing
End If
Next k&
Next i&
MsgBox Format(Time - t1, "hh:mm:ss"), vbInformation, " Temps d'exécution"
End Sub
'__________________
Sub Affichage()
Cells.ColumnWidth = 0.33
Cells.RowHeight = 3.33
Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
End Sub
'__________________
Function algoTri(ByVal limiteinf&, ByVal limitesup&, ByRef tabtri() As
Variant)
Dim i&
Dim j&
Dim element
Dim transit
i& = limiteinf
j& = limitesup
transit = tabtri((limiteinf + limitesup) 2)
Do
Do While tabtri(i&) < transit
i& = i& + 1
Loop
Do While transit < tabtri(j&)
j& = j& - 1
Loop
If i& <= j& Then
element = tabtri(i&)
tabtri(i&) = tabtri(j&)
tabtri(j&) = element
i& = i& + 1
j& = j& - 1
End If
Loop Until i& > j&
If limiteinf < j& Then
Call algoTri(limiteinf, j&, tabtri())
End If
If i& < limitesup Then
Call algoTri(i&, limitesup, tabtri())
End If
End Function
'*****************

Avez-vous le même gain de temps ?

Cordialement.

PMO
Patrick Morange



Avatar
Jac
Bonjour Patrick,

avec ta version, je suis passé de 19 à 7s soit 2.71 x + vite !
Avec Application.ScreenUpdating = False "ça" gagne autour de 28 % :
"ça" passe à 14 pour la première version et à 5s pour ta version
optimisée.

Chez toi, le coeff varie de 2.83 à 2.57



Bien vu... mais rien compris !!!

Jac

PS : il faudrait aller un peu plus loin qu'avec les secondes parce
qu'avec des temps courts, 9s, ça va de 8,501 à 9,499 soit 11%, ce qui
est quand même assez important quand on fait des comparaisons.

Voici le vba pour un calcul au millième de seconde :

' début du chrono ------------------------------
TEMPS = Timer


' fin du chrono --------------------------------
MsgBox vbTab & Format(Timer - TEMPS, "0.000") & " seconde(s)", , _
" La procédure a été réalisée en..."


Bonjour,

Au sujet des fractales et de votre quête de vitesse

En ayant optimisé votre code, j'obtiens un gain de temps significatif.
Avec ma machine processeur Core 2 Duo 2.33 GHz
j'obtiens 17s/18s avec votre code et 6s/7s avec le code modifié.


Avez-vous le même gain de temps ?

Cordialement.

PMO
Patrick Morange


Avatar
Jac
Bonjour à tous,

à toute fin utile, voici mes test de calcul en ram et d'affichage
vidéo.

Je les utilise chaque fois qu'il s'agit de tester une machine avant
achat (premiers tests en 1994...).

Ça m'a déjà permis de rapporter un PC au vendeur qui m'avait affirmé
mordicus, en ce temps là, qu'un AMD 3800+ 64 bits, me donnerait des
résultats "époustouflants".
La vidéo me donnait 9.31s alors que l'ancienne machine (Athlon 2800)
était à 19.28, mais le test en ram me faisait passer de 18.94 à 15.93
alors que mon "vieux" portable Acer 17" avec son P4 3.06 en était déjà
à 10.17 !!!

Donc changement de machine : P4 3.42 pour 10.27s en ram et 18.59s en
vidéo.

Actuellement DuoCore2 - 6600 2.4 pour 9.81s en ram et 9.61 en vidéo.

Donc en 4 ans, j'ai gagné moins d'une demie seconde sur mon test, soit
6,5 % + rapide, en ayant vu passer 3 machines.

Conclusion : ça évolue mais à pas de fourmi. C'est sûr que mes critères
ne sont pas des benschmark, ni du 3d, ni des jeux.
Seulement les jeux que l'on trouve dans Office... ou ceux qui font du
traitement d'image.

Jac


Sub TESTVIDEO()
Workbooks.Add: [A:A].ColumnWidth = 30
[A1].Font.Name = "Arial Black": [A1].Font.Size = 36
' __________boucle vidéo_____de 1 à 50.000________
TEMPS = Timer
For Var = 1 To 50000: [A1] = Var: Next Var
MsgBox vbTab & Format(Timer - TEMPS, "0.000") & " seconde(s)", , _
" La procédure a été réalisée en..."
End Sub


Sub TESTRAM()
' __________boucle en ram_____de 1 à 1.000.000.000_______
TEMPS = Timer
For Var = 1 To 1000000000: Next Var
MsgBox vbTab & Format(Timer - TEMPS, "0.000") & " seconde(s)", , _
" La procédure a été réalisée en..."
End Sub
Avatar
Modeste
Bonsour® Jac avec ferveur ;o))) vous nous disiez :

PS : il faudrait aller un peu plus loin qu'avec les secondes parce
qu'avec des temps courts, 9s, ça va de 8,501 à 9,499 soit 11%, ce qui
est quand même assez important quand on fait des comparaisons.


En début de module :
Declare Function GetTickCount& Lib "kernel32" ()

dans la proc :
en debut
Dim t1&, t2&
t1& = GetTickCount&

en fin :
t2& = GetTickCount& - t1&
MsgBox t2& / 1000 & " sec", vbInformation, " Temps d'exécution"

--
--
@+
;o)))

Avatar
PMO
Bonjour Jac,

Bien vu... mais rien compris !!!





Quelques explications :

L'optimisation porte uniquement sur la couleur du fonds des cellules.
L'instruction de Tatanka
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j))) Mod 56
colorie les cellules une par une et c'est cela qui ralentit le code.
La piste est d'inscrire chaque couleur d'un seul coup dans les cellules
concernées.

Il faut donc :
1) récupérer les index de couleur dans un tableau bidimensionné
Dim index%(1 To LIG_MAX, 1 To COL_MAX)
2) connaître le nombre d'index différents. Pour cela on crée un tableau
dimensionné
de 1 à nombre de cellules concernées pour y inscrire chaque index
Dim myTab(LIG_MAX * COL_MAX)
On trie ce tableau au moyen de la fonction algoTri ( 130050 lignes )
On fait une boucle sur ce tableau et chaque fois qu'on rencontre un
index différent on l'affecte dans le tableau Couleurs
3) On inscrit les couleurs des cellules d'un seul coup sauf que je le fais
ligne par ligne. J'ai pris cette option pour avoir un visuel utilisateur
plus joli et
je n'use pas, par conséquent, de ApplicationScreeUpdating = False
A - boucle sur toutes les lignes
B - (y imbriquée) boucle sur toutes les couleurs trouvées
C - (y imbriquée) boucle sur toutes les colonnes
Faire une Union de toutes les cellules de la ligne ayant la même couleur
et appliquer, en une seule fois, la couleur à cette Union.

Si le gain en rapidité est d'un facteur 2à3, le nombre de lignes
du code est multiplié par 5. On améliore d'un côté et on alourdit de l'autre.
Faites votre choix.

Cordialement.

PMO
Patrick Morange




Avatar
Jac
Bonjour Patrick,

un grand merci pour ces explications.

Je trouve que j'ai trop tendance à vouloir écrire les données au fur et
à mesure de leur acquisition plutôt que de remplir des variables et de
tout lâcher d'un seul coup.

Bon dimanche,

Jac

Bonjour Jac,

Bien vu... mais rien compris !!!





Quelques explications :

L'optimisation porte uniquement sur la couleur du fonds des cellules.
L'instruction de Tatanka
Cells(i, j).Interior.ColorIndex = Abs((i Imp j) Or (i + Not (j))) Mod 56
colorie les cellules une par une et c'est cela qui ralentit le code.
La piste est d'inscrire chaque couleur d'un seul coup dans les cellules
concernées.

Il faut donc :
1) récupérer les index de couleur dans un tableau bidimensionné
Dim index%(1 To LIG_MAX, 1 To COL_MAX)
2) connaître le nombre d'index différents. Pour cela on crée un tableau
dimensionné
de 1 à nombre de cellules concernées pour y inscrire chaque index
Dim myTab(LIG_MAX * COL_MAX)
On trie ce tableau au moyen de la fonction algoTri ( 130050 lignes )
On fait une boucle sur ce tableau et chaque fois qu'on rencontre un
index différent on l'affecte dans le tableau Couleurs
3) On inscrit les couleurs des cellules d'un seul coup sauf que je le fais
ligne par ligne. J'ai pris cette option pour avoir un visuel utilisateur
plus joli et
je n'use pas, par conséquent, de ApplicationScreeUpdating = False
A - boucle sur toutes les lignes
B - (y imbriquée) boucle sur toutes les couleurs trouvées
C - (y imbriquée) boucle sur toutes les colonnes
Faire une Union de toutes les cellules de la ligne ayant la même couleur
et appliquer, en une seule fois, la couleur à cette Union.

Si le gain en rapidité est d'un facteur 2à3, le nombre de lignes
du code est multiplié par 5. On améliore d'un côté et on alourdit de l'autre.
Faites votre choix.

Cordialement.

PMO
Patrick Morange






1 2 3 4