[VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Staple1600 · 11 Février 2010

Bonsoir à tous

Je sollicite votre aide pour essayer d'améliorer un code VBA utilisé pour mettre en forme un grand nombre de cellules.

Je vous invite à regarder la pièce jointe pour tester et j'espère que vos propositions réduiront le temps d'exécution de la macro

(qui sur mon PC domestique s'exécute en 3 secondes)

Merci à tous ceux qui s'arrêteront dans ce fil.

ROGER2327 · 12 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonjour Staple1600

L'essentiel du temps d'exécution est dû à la modification du format du texte dans les cellules, et je ne vois guère comment on pourrait faire ce formatage ailleurs.
Toutefois, on peut gagner un peu (très peu) de temps en optimisant la gestion des variables et, surtout, en inversant les boucles.
La procédure colo étant appelée une seule fois, on peut l'intégrer dans la procédure principale, gagnant ainsi le temps d'appel, mais le gain est extrêmement faible.
Par exemple :

Code:

[COLOR="DarkSlateGray"][B]Sub mise_en_forme()
Dim tt, ttt, d_l&, j&, k&
Dim t, M$, r As Range
Dim Debut As Currency, Fin As Currency, Freq As Currency
   QueryPerformanceCounter Debut
   Application.ScreenUpdating = False
   tt = Array(0, 2, 5, 7, 9)
   ttt = Array(30, 45, 23, 12, 12)
   With Feuil1
      d_l = .Cells(.Rows.Count, 2).End(xlUp).Row
      For j = 1 To d_l
         Set r = .Cells(j, 2)
         t = Split(r.Text)
         For k = 0 To UBound(tt)
            M = t(tt(k))
            With r.Characters(InStr(1, r.Text, M), Len(M)).Font
               .ColorIndex = ttt(k)
               .Bold = True
               .Underline = True
            End With
         Next k
      Next j
   End With
   QueryPerformanceCounter Fin
   QueryPerformanceFrequency Freq
   [A13] = Format(((Fin - Debut) / Freq), "0.00") & " s"
   Application.ScreenUpdating = True
End Sub[/B][/COLOR]

Une autre tentative, en effectuant la conversion des données dans une feuille annexe temporaire au lieu d'utiliser Split(), ne donne pas de meilleurs résultats :

Code:

[COLOR="DarkSlateGray"][B]Sub mise_en_forme()
Dim tt, ttt, d_l&, j&, k&
Dim M$, r As Range, rr As Range, oDat
Dim Debut As Currency, Fin As Currency, Freq As Currency
   QueryPerformanceCounter Debut
   Application.ScreenUpdating = False
   tt = Array(1, 3, 6, 8, 10)
   ttt = Array(30, 45, 23, 12, 12)
   With Feuil1
      d_l = .Cells(65536, "B").End(xlUp).Row
      Set rr = .Range(.Cells(1, "B"), .Cells(d_l, "B"))
      Worksheets.Add before:=Sheets(1)
      With ActiveSheet
         rr.Copy Destination:=.Cells(1, 1)
         .Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell)).TextToColumns _
            Destination:=.Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, _
            Space:=True, Other:=False, TrailingMinusNumbers:=True
         oDat = .Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell)).Value
         Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
      End With
      .Activate
      For j = 1 To d_l
         Set r = rr.Item(j)
         For k = 0 To UBound(tt)
            M = oDat(j, tt(k))
            With r.Characters(InStr(1, r.Text, M), Len(M)).Font
               .ColorIndex = ttt(k)
               .Bold = True
               .Underline = True
            End With
         Next k
      Next j
   End With
   QueryPerformanceCounter Fin
   QueryPerformanceFrequency Freq
   [A13] = Format(((Fin - Debut) / Freq), "0.00") & " s"
   Application.ScreenUpdating = True
End Sub[/B][/COLOR]

J'attends avec intérêt la suite de la discussion pour savoir si quelqu'un trouve une alternative plus rapide à la procédure colo...

ROGER2327
#2750

JNP · 12 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonjour le fil

,
Une première mesure avec le fichier de base :
En mode compatible (2003 sous 2007) : 11.8 secondes !!!
En XLSM pur : 6.8 secondes !!!
Conclusion, mon PC est moins performant que celui de Jean-Marie, pourtant c'est quand même un Quad à 2.33 GHz 64 bit (Excel n'est qu'en 32, mais en multi thread) sous Seven 64 avec 8Go de RAM et boosté avec TuneUp 2010... Jean-Marie, faudra que tu me donnes ta recette

...
Pour le code, j'essayerai d'y jeter un œil ce WE, ça rejoint un peu des discussions récentes sur le forum, mais pour l'effet inverse : récupérer la mise en forme pour la coder en HTML pour le Body d'un mail...
Bonne journée

Ajout : le code de Roger me donne 5.82 secondes (soit 20% de gain).

Staple1600 · 12 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonsoir à tous

Merci de votre intérêt

En effet avec la macro (la 1ère) de ROGER237, j'obtiens un temps d'exécution de 2.76 s et 2.79 avec la seconde macro.

Je testerai lundi sur le PC de l'utilisateur final (qui est moins récent et sous XP + Excel 2003)

JNP: j'ai un PC non boosté (VISTA + Excel 2000 + 3 Go de RAM)

Roland_M · 12 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

bonsoir à tous

ce qui prend le plus de temps c'est ceci :
.Bold = True
.Underline = True
les mettre en rem pour voir le temps diminuer de plus de la moitié !

on peut aussi gagner très légèrement en ne mettant les var aux next
Next K le K est inutile
Next J le J est inutile

Staple1600 · 12 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonsoir Roland_M

Le problème est que le gras et souligné font partie de la demande.

Je crois que je vais essayer de convaincre l'utilisateur d'opter pour une cellule par mot.

Je vais tester de suite ce que cela donne.

EDITION: C'est mieux

: 0,07 s avec la macro ci-dessous

1) pour créer des données de test, lancer set_data_test
2) pour mettre en forme : lancer mise_en_formeII

Code:

Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean

Code:

Sub mise_en_formeII()
Dim tt, ttt, k&, d_l&
Dim Debut As Currency, Fin As Currency, Freq As Currency
tt = Array(2, 4, 6, 8, 10): ttt = Array(30, 45, 23, 12, 12)
QueryPerformanceCounter Debut
Application.ScreenUpdating = False
With Feuil1
    d_l = .Cells(65536, "B").End(xlUp).Row
    For k = 0 To UBound(tt)
        With Cells(1, CLng(tt(k))).Resize(d_l)
            With .Font
            .ColorIndex = CLng(ttt(k)): .Bold = True: .Underline = True
            End With
        End With
    Next
End With
QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
[A13] = Format(((Fin - Debut) / Freq), "0.00") & " s"
Application.ScreenUpdating = True
End Sub

Code:

Private Sub CREERDONNEEES(r$, nbl&)
Dim s
s = Split("MOT1 MOT2 MOT3 MOT4 MOT5 MOT6 MOT7 MOT8 MOT9 MOT10 MOT11")
Range(r).Resize(nbl, UBound(s)).Value = s
End Sub

Code:

Sub set_data_test()
[A13] = Empty
[B1:K3000].Clear
CREERDONNEEES "B1", 3000
End Sub

ROGER2327 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re...

Vous avez des machines rapides !
Dans le meilleur des cas, mes procédures d'hier prennent 9,2 secondes chez moi !

ROGER2327
#2753

ROGER2327 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Suite...

Bonjour Staple1600,

La nouvelle mouture est effectivement plus rapide : 0,1 s.

(Mais ce n'est plus le même problème...)

ROGER2327
#2754

Staple1600 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re, bonsoir ROGER2327

J'ai un doute quand à la véracité du temps d'exécution renvoyé par
QueryPerformanceCounter

Je vais tester avec un autre code de "chronométrage"

EDITION: avec cette méthode : 0.14 secondes

Code:

Private Declare Function GetTickCount Lib "kernel32" () As Long

Code:

Sub mise_en_formeII()
Dim tt, ttt, k&, d_l&
Dim dTps As Double
On Error GoTo e_rror
dTps = GetTickCount
tt = Array(2, 4, 6, 8, 10): ttt = Array(30, 45, 23, 12, 12)
Application.ScreenUpdating = False
With Feuil1
    d_l = .Cells(65536, "B").End(xlUp).Row
    For k = 0 To UBound(tt)
        With Cells(1, CLng(tt(k))).Resize(d_l)
            With .Font
            .ColorIndex = CLng(ttt(k)): .Bold = True: .Underline = True
            End With
        End With
    Next
End With
Application.ScreenUpdating = True
dTps = GetTickCount - dTps
MsgBox Format(dTps / 1000, "0.000") & " secondes.", vbInformation, "MISE EN FORME EFFECTUEE EN :"
Exit Sub
e_rror:
MsgBox "Y'a comme une erreur Chef!"
End Sub

JNP · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re

,
Effectivement, avec cette méthode, je repasse devant : 0.078 secondes

.
Par contre, en reprenant le code de départ de Roger, je me retrouve à 6.178 secondes, soit pas beaucoup d'amélioration...
Bon WE

pierrejean · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonjour a tous

J'en etait resté au probleme d'origine
Voici ce que j'ai pu obtenir (Resultat entre la version originelle et celle de ROGER )

Staple1600 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Bonjour pierrejean

Merci de passer par ici.

Chez moi avec ton classeur, le code de ROGER23727 reste plus rapide.

La mienne étant la moins rapide.

Je ne vois pas comment cela pourrait se réduire encore (en restant avec la chaine de caractère dans une cellule et non pas un mot par cellule)

ROGER2327 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re...

Test sur le classeur de pierrejean (moyenne de cinq essais) :

pierrejean : 10,32 s ;
ROGER : 10,22 s ;
procédure originale : 10,54 s.

Difficile de tirer une conclusion...

(...) Je ne vois pas comment cela pourrait se réduire encore (en restant avec la chaine de caractère dans une cellule et non pas un mot par cellule) (...)

Moi non plus...
Mais attendons...

ROGER2327
#2757

pierrejean · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re

Ma pretention n'etait pas de faire mieux que ROGER et je me satisfait bien, deja ,d'avoir passé le probleme posé par le double espace insidieusement mis entre MOT4 et MOT5

ROGER2327 · 13 Février 2010

Re : [VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Re... Bonjour pierrejean

Je ne crois pas qu'une solution soit supérieure à l'autre. La vôtre a le mérite de la concision et les différences en matière de temps d'exécution ne sont pas vraiment significatives. Je crois que le problème est de trouver un truc plus rapide que la procédure colo initialement proposée par Staple1600. Mais je ne vois vraiment pas lequel...

Cordialement,
ROGER2327
#2760

Effectuez une recherche sur Excel Downloads...

[VBA] Optimiser macro pour utilisation sur PC ancien (Array vs Boucles)

Staple1600

XLDnaute Barbatruc

Staple1600

ROGER2327

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Roland_M

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

JNP

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

Staple1600

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums