Vitesse exécution VBA Excel

Version imprimable

07/12/2022, 11h34
P4board

Vitesse exécution VBA Excel

Bonjour, après avoir difficilement lâché Excel 2003 puis 2010 pour passer à la 2019 depuis 2-3 ans, j'avais vu que mes scripts VBA étaient devenus particulièrement mous. Je finalise un projet et j'ai pu faire des mesures sans trouver de solutions malgré le nombre de retours négatifs sur ce point.

Tout d'abord mon script ne travaille que sur un nombre limité de cellules : intersection d'environ 65 colonnes et 40 lignes. Aucune données et aucun script en dehors ou sur ligne ou colonne entière.
Mon script agit visuellement pour l'utilisateur avec réglage de la vitesse d'exécution géré par un Timer. Donc j'ai besoin du ScreenUpdating et xlCalculationAutomatic. Les désactiver est effectivement très efficace, mais ça n'a plus aucun sens dans le cas de mon projet.

Pour que vous compreniez l'idée :

Sur la feuille :

Sub Worksheet_Change(ByVal Target As Excel.Range)
Call Modifier(Target)
End Sub

Dans un module :

Sub Modifier(ByVal Target As Excel.Range)
ThisColumn = Target.Column
Select Case ActiveSheet.Cells(7, ThisColumn).Value
Case "0"
ActiveSheet.Cells(5, ThisColumn).Interior.Color = RGB(244, 176, 132)
ActiveSheet.Cells(5, ThisColumn).Borders.LineStyle = xlContinuous
ActiveSheet.Cells(5, ThisColumn).Borders.Weight = xlMedium
...

J'ai enregistré mon fichier au format XLSM et au format XLS 2003.

Même ordinateur (PC fixe), même configuration matérielle (bonne), même disque d'exécution (clé USB)... A vitesse d'exécution 1ms - idem si je court-circuite le Timer qui n'est pas la cause du problème, mais bien la gestion graphique en temps réel :

XLS sous WinXP 32 - Excel 2010 : 2 minutes 14 secondes
XLS sous Win10 64 - Excel 2019 : 4 minutes 50 secondes
XLSM sous Win10 64 - Excel 2019 : 15 minutes 47 secondes

Le script est donc 7x plus lent, ce qui n'est pas sans conséquence, car ce n'est pas pareil d'attendre 3 minutes et 16 minutes, surtout si on doit relancer le script plusieurs fois.

Même soucis et temps sur un DELL portable avec une quadro et un i7 fichier directement sur SSD.

Au boulot, j'ai cru voir que sur certains postes, ça allait plutôt vite alors que sur d'autres c'était encore plus lent.

Si vous avez des idées, y compris modification système. Dois-je plustôt privilégier le format XLS 2003 ? C'est ce que je faisais, constatant la disparition des macros dans le XLSX et avant de découvrir le XLSM. Aujourd'hui, j'ai plutôt tendance à convertir en XLSM, mais c'est peut-être une 1ère erreur, j'ai rarement besoin de plus de 2^16 lignes.

Merci,

Olivier.
07/12/2022, 13h18
Tête de chat

Bonjour,

pas facile de te répondre avec aussi peu d'éléments. Le temps de réponse que tu évoques est monstrueux donc certaines choses doivent se passer différemment de ce que tu imagines, par exemple :
- modifs en cascade,
- recherche de choses qui n'existent pas
- modif ciblant une plage trop grande (par exemple une colonne)

Donc sans voir le code ni pouvoir tester...
07/12/2022, 17h01
P4board

Bonjour, et merci pour votre réponse. Non rien de tout ça, j'ai évidemment cherché et fait pas mal de tests.

Ce sont les modifications de style des cellules du type ActiveSheet.Cells(5, ThisColumn).Interior.Color = RGB(244, 176, 132) qui demandent du temps. Les désactiver, même très localement, avec un Application.ScreenUpdating = False est radical, mais ce n'est pas ce qui me convient. Les anciennes versions d'Excel géraient ça très bien, là la 2019 semble ne pas bien le gérer. J'ai un autre fichier qui rame de manière excessive depuis le passage en 2019, mais sans trop de conséquences, j'ai préféré faire avec que de perdre du temps à chercher. Là, je peux difficilement me permettre de faire avec.

Je fais tourner exactement le même code qui ne modifie jamais une plage, mais toujours 1 seule cellule à la fois. Les modifications sont par contre très rapides puisqu'il s'agit de suivre visuellement le parcours des boucles. Je peux ralentir avec le Timer, mais une fois que c'est OK, j'aimerais le laisser rouler le plus vite possible.

Je suppose que ce doit être en lien avec la carte et paramètres graphique. Ou un paramètre Excel quelque part. Sur le PC fixe core 2 duo E8500 / quadro fx4600, sur le portable i7 / Quadro K2000M. A peu près équivalent, légèrement plus rapide sur le portable. Au lycée, il y a des pcs fixes avec des quadro pas trop vieux qui ont l'air d'exécuter le code plus vite (XSLM - Excel 2019). Sur des ordis sans carte graphique particulière, ça rame, mais pas beaucoup moins qu'avec mes ordis. Je ne pourrais vraiment tester sur les ordis du lycée que semaine prochaine.

Re,

toujours pas très clair ce que fait ton code...

Histoire d'avancer, j'ai fait ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Const imax = 40
Const jmax = 65
 
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Time()
Dim i As Integer, j As Integer
For i = 1 To imax
    For j = 1 To jmax
        ActiveSheet.Cells(i, j).Interior.Color = RGB(244, 176, 132)
    Next j
Next i
Debug.Print Time()
End Sub

Dans un XLSM, chez moi ça prend 4 s.

07/12/2022, 18h11
deedolith

Salut, quelques pistes:

- Fait un maximum de chose avec les fonctionnalités native d'Excel (Formules, Mise en forme conditionnelles, Tableau Structurés, Tableau croisés dynamiques, Power Query ect ...).
- Chronomètre les diverses fonctionnalités développées pour savoir la ou lesquelles font perdre du temps (un chronometre general n'est pas assez précis).
- Respect du SRP ?
- Respect de la Loi de Demeter ?
- Passage de paramètres (ByRef / ByVal) ?
07/12/2022, 18h27
P4board

1 pièce(s) jointe(s)

Bonjour, je vous joins un petit exemple d'un truc qui ne sert évidemment à rien, mais qui montre parfaitement le problème. Un petit aller retour sous XP pour me rendre compte que c'est la version 2003 et non 2010 que j'ai installé. Au lycée, on est sous 2019, donc c'est avec cette version qu'il faut que ça fonctionne.

50 tours :

XLS sous WinXP 32 - Excel 2003 : 5 secondes (une bombe !)
XLS sous Win10 64 - Excel 2019 : 41 secondes
XLSM sous Win10 64 - Excel 2019 : 1 minutes 35 secondes

Ratio : 19

-------------

Edit : test XLSM avec Application.ScreenUpdating = False en début de programme : 18 secondes. C'est mieux, mais encore moins bien que 2003 et sans visuel.
07/12/2022, 19h07
deedolith
Met en place des références fixes. Cela évitera la résolution des référencs à chaque appel de ActiveSheet.
Code:

1 2 3 4 5 6 Dim Sh As excel.Worksheet Set Sh = Me For i = 1 To 50 Sh.Cells(5, 4).Value = i Sh.Cells(5, 5).Value = ChrW(&H2191) '// ect ....
Vires tous les formatages de cellules au profit de formatage conditionnel. Le code VBA ne se contentera de mettre à jour que les valeurs de cellule.
Rien qu'en mettant en commentaires les lignes altérant le formatage, j'ai obtenu un gain significatif (à vue de nez: 6 - 7 secondes).
07/12/2022, 23h30
P4board

Merci pour ces idées. J'ai viré ma Sub Worksheet_Change(ByVal Target As Excel.Range) et j'ai passé les formatages associés en formatages conditionnels. Je pourrais en faire quelques autres, mais il faudrait que je modifie beaucoup de choses. D'autres formatages ne peuvent pas passer en conditionnel, car c'est la macro qui doit gérer un formatage qui n'est pas linéaire. Mais ça en élimine déjà une grosse partie moyennant un travail beaucoup plus laborieux de formatage conditionnel cellule par cellule, feuille par feuille.

J'ai également mis en place des références fixes comme indiqué. C'est plus efficace qu'un with ? Je ne suis pas au point là-dessus.

Quoi qu'il en soit, ça ne change pas beaucoup, je gagne environ 2 minutes soit 15%. Ce n'est pas rien non plus.

Mais à mon avis, le noyau dur est ailleurs.

Hello,
voici le résultat d'un test de performance en utilisant la classe cBenchmark avec ce code :

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
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
Sub CommandButton1_Click()
    Dim i As Integer
    Dim j As Integer
    Dim bm As New cBenchmark
    bm.TrackByName "Initialisations"
    For i = 1 To 50
        ActiveSheet.Cells(5, 4).Value = i
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2191)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            If j > 1 Then
                ActiveSheet.Cells(1, j - 1).Interior.Color = xlNone
                ActiveSheet.Cells(1, j - 1).Borders.LineStyle = xlLineStyleNone
                ActiveSheet.Cells(1, j - 1).Value = ""
            End If
            ActiveSheet.Cells(1, j).Interior.Color = RGB(244, 176, 132)
            ActiveSheet.Cells(1, j).Borders.LineStyle = xlContinuous
            ActiveSheet.Cells(1, j).Borders.Weight = xlMedium
            ActiveSheet.Cells(1, j).Value = ChrW(&H2192)
            DoEvents
            bm.TrackByName "Boucle J Droite"
        Next j
        DoEvents
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2192)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            If j > 1 Then
                ActiveSheet.Cells(j - 1, 10).Interior.Color = xlNone
                ActiveSheet.Cells(j - 1, 10).Borders.LineStyle = xlLineStyleNone
                ActiveSheet.Cells(j - 1, 10).Value = ""
            End If
            ActiveSheet.Cells(j, 10).Interior.Color = RGB(244, 176, 132)
            ActiveSheet.Cells(j, 10).Borders.LineStyle = xlContinuous
            ActiveSheet.Cells(j, 10).Borders.Weight = xlMedium
            ActiveSheet.Cells(j, 10).Value = ChrW(&H2193)
            DoEvents
            bm.TrackByName "Boucle J Bas"
        Next j
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2193)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            If j > 1 Then
                ActiveSheet.Cells(10, 11 - j + 1).Interior.Color = xlNone
                ActiveSheet.Cells(10, 11 - j + 1).Borders.LineStyle = xlLineStyleNone
                ActiveSheet.Cells(10, 11 - j + 1).Value = ""
            End If
             ActiveSheet.Cells(10, 11 - j).Interior.Color = RGB(244, 176, 132)
             ActiveSheet.Cells(10, 11 - j).Borders.LineStyle = xlContinuous
             ActiveSheet.Cells(10, 11 - j).Borders.Weight = xlMedium
             ActiveSheet.Cells(10, 11 - j).Value = ChrW(&H2190)
            DoEvents
            bm.TrackByName "Boucle J Gauche"
        Next j
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2190)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            If j > 1 Then
                ActiveSheet.Cells(11 - j + 1, 1).Interior.Color = xlNone
                ActiveSheet.Cells(11 - j + 1, 1).Borders.LineStyle = xlLineStyleNone
                ActiveSheet.Cells(11 - j + 1, 1).Value = ""
            End If
            ActiveSheet.Cells(11 - j, 1).Interior.Color = RGB(244, 176, 132)
            ActiveSheet.Cells(11 - j, 1).Borders.LineStyle = xlContinuous
            ActiveSheet.Cells(11 - j, 1).Borders.Weight = xlMedium
            ActiveSheet.Cells(11 - j, 1).Value = ChrW(&H2191)
            DoEvents
            bm.TrackByName "Boucle J Haut"
        Next j
        bm.TrackByName "Boucle i"
    Next i
    bm.TrackByName ("Fin")
    ActiveSheet.Cells(1, 1).Interior.Color = xlNone
    ActiveSheet.Cells(1, 1).Borders.LineStyle = xlLineStyleNone
    ActiveSheet.Cells(1, 1).Value = ""
    ActiveSheet.Cells(5, 4).Value = ""
    ActiveSheet.Cells(6, 4).Value = ""
    ActiveSheet.Cells(5, 5).Value = ""
End Sub

J'ai rajouté des doEvents pour redonner la main au système pour pouvoir arrêter la macro.
Résultat du benchmark :
I

Citation:

Dnr Name Count Percentage Time sum
0 Initialisations 1 0,00% 58 us
1 Boucle J Droite 500 13,45% 43,5 s
2 Boucle J Bas 500 21,70% 70,1 s
3 Boucle J Gauche 500 44,60% 144,1 s
4 Boucle J Haut 500 20,24% 65,4 s
5 Boucle i 50 0,00% 561 us
6 Fin 1 0,00% 7100 ns

TOTAL 2 052 100,00% 323,1 s

Total time recorded: 323,1 s

On peut constater que le déplacement vers la gauche est beaucoup plus lent que le déplacement vers la droite.
Ami calmant, J.P

2 pièce(s) jointe(s)

Hello,
c'est plus rapide en utilisant des objets graphiques.
Code :

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
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
Sub Traitement()
    Dim i As Integer
    Dim j As Integer
    Dim bm As New cBenchmark
    ActiveSheet.Range("A1").Select
    bm.TrackByName "Initialisations"
    For i = 1 To 50
        ActiveSheet.Cells(5, 4).Value = i
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2192)
        DoEvents
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            ActiveSheet.Shapes("FlecheD").Top = ActiveSheet.Cells(1, j).Top
            ActiveSheet.Shapes("FlecheD").Left = ActiveSheet.Cells(1, j).Left
            DoEvents
            bm.TrackByName "Boucle J Droite"
        Next j
        ActiveSheet.Shapes("FlecheD").Top = ActiveSheet.Range("B4").Top
        ActiveSheet.Shapes("FlecheD").Left = ActiveSheet.Range("B4").Left
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2193)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            ActiveSheet.Shapes("FlecheB").Top = ActiveSheet.Cells(j, 10).Top
            ActiveSheet.Shapes("FlecheB").Left = ActiveSheet.Cells(j, 10).Left
            DoEvents
            bm.TrackByName "Boucle J Bas"
        Next j
        ActiveSheet.Shapes("FlecheB").Top = ActiveSheet.Range("C4").Top
        ActiveSheet.Shapes("FlecheB").Left = ActiveSheet.Range("C4").Left
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2190)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            ActiveSheet.Shapes("FlecheG").Top = ActiveSheet.Cells(10, 11 - j).Top
            ActiveSheet.Shapes("FlecheG").Left = ActiveSheet.Cells(10, 11 - j).Left
            DoEvents
            bm.TrackByName "Boucle J Gauche"
        Next j
        ActiveSheet.Shapes("FlecheG").Top = ActiveSheet.Range("D4").Top
        ActiveSheet.Shapes("FlecheG").Left = ActiveSheet.Range("D4").Left
        ActiveSheet.Cells(5, 5).Value = ChrW(&H2191)
        For j = 1 To 10
            ActiveSheet.Cells(6, 4).Value = j
            ActiveSheet.Shapes("FlecheH").Top = ActiveSheet.Cells(11 - j, 1).Top
            ActiveSheet.Shapes("FlecheH").Left = ActiveSheet.Cells(11 - j, 1).Left
            DoEvents
            bm.TrackByName "Boucle J Haut"
        Next j
        ActiveSheet.Shapes("FlecheH").Top = ActiveSheet.Range("E4").Top
        ActiveSheet.Shapes("FlecheH").Left = ActiveSheet.Range("E4").Left
 
        bm.TrackByName "Boucle i"
    Next i
    bm.TrackByName ("Fin")
    ActiveSheet.Shapes("FlecheD").Top = ActiveSheet.Range("B4").Top
    ActiveSheet.Shapes("FlecheD").Left = ActiveSheet.Range("B4").Left
    ActiveSheet.Shapes("FlecheB").Top = ActiveSheet.Range("C4").Top
    ActiveSheet.Shapes("FlecheB").Left = ActiveSheet.Range("C4").Left
    ActiveSheet.Shapes("FlecheG").Top = ActiveSheet.Range("D4").Top
    ActiveSheet.Shapes("FlecheG").Left = ActiveSheet.Range("D4").Left
    ActiveSheet.Shapes("FlecheH").Top = ActiveSheet.Range("E4").Top
    ActiveSheet.Shapes("FlecheH").Left = ActiveSheet.Range("E4").Left
End Sub

Pièce jointe 630408

Citation:

Performance :
IDnr Name Count Sum of tics Percentage Time sum
0 Initialisations 1 433 0,00% 43 us
1 Boucle J Droite 500 111 115 765 26,14% 11,1 s
2 Boucle J Bas 500 105 193 903 24,75% 10,5 s
3 Boucle J Gauche 500 104 204 169 24,51% 10,4 s
4 Boucle J Haut 500 104 004 814 24,47% 10,4 s
5 Boucle i 50 580 098 0,14% 58 ms
6 Fin 1 95 0,00% 9500 ns
TOTAL 2 052 425 099 277 100,00% 42,5 s

Total time recorded: 42,5 s

[EDIT] Animation en remplaçant les DoEvents par

Code:

1
2
 
bm.Sleep 0.1, True

tempo de 100 ms avec un DoEvents

Pièce jointe 630432

Ami calmant, J.P