Optimisation temps execution d'une macro

**Ltspitfire** · 21/01/2015, 10h58

Bonjour,

J'ai créé une macro qui rempli un tableau à partir des informations contenues dans deux autres feuilles du même classeur. La macro fonctionne, pas de soucis de ce coté la. De même lorsqu'il y a peu de colonne/ligne comme dans l'exemple que je fais suivre, la macro est instantanée. Le problème survient lorsque je passe à un nombre important de colonne/ligne. En effet la macro met 2 minutes à s'executer et j'aimerais porter ce temps d'execution à une dizaine de seconde dans le meilleur des cas. J'ai donc longuement chercher à optimiser mon code à l'aide des conseils trouvés sur plusieurs forum : Enlever un maximum de select, application.sreenupdating = false , etc.

La lenteur provient de la deuxième partie de la boucle contenue dans la fonction "TraitementDates".

Je reste à votre disposition pour toutes informations complémentaires.

Merci d'avance.

Cordialement,
Ltspitfire

**Nico Chg** · 21/01/2015, 11h40

Bonjour,

Je n'ouvre que très rarement les pièces jointes, peux tu poster ton code (celui de ta boucle, tout du moins), sur le forum ?
Sinon, une très bonne méthode d'optimisation, en ce qui concerne les boucles, reste les variables tableaux.

Je ne connais pas le détails de tes fonctions, mais je sais que boucler dans une variable tableau met beaucoup moins de temps que de boucler sur un objet Worksheet.

D'expérience personnel, tu peux réduire des temps d’exécution de 15min à quelques secondes.

Pour plus d'information :
Tutoriel de SilkyRoad

**Ltspitfire** · 21/01/2015, 12h05

Re,

Voila la fonction responsable de la lenteur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function TraitementDates(DateSyn, NomNewSheet)
    DateSynF = Format("01/" & DateSyn, "MM/YYYY")
    DerLi = Worksheets(NomNewSheet).Range("A" & Rows.Count).End(xlUp).Row
    DerLiTable = Worksheets("Table").Range("E" & Rows.Count).End(xlUp).Row
    Worksheets("BDD").Activate
    PremDomBDD = PremDom()
    DernColBDD = Range("XFD9").End(xlToLeft).Column
    Worksheets(NomNewSheet).Activate
    y = 0
    ' Parcours de chaque agent
    While y <= DerLi - 6
        If CDate(Worksheets("BDD").Range("D10").Offset(y, 0).Value) < CDate(DateSyn) And Worksheets("BDD").Range("D10").Offset(y, 0).Value <> "" Then
            GoTo 4
        End If
        x = 0
        ' Remplissage des X
        While x <= 11
            If Worksheets("BDD").Range("E10").Offset(y, x).Value <> "" Then
                DateTest = Format(Worksheets("BDD").Range("E10").Offset(y, x).Value, "MM/YYYY")
                If CDate(DateTest) > CDate(DateSynF) Then
                    Worksheets(NomNewSheet).Range("B7").Offset(y, x).Value = "P"
                    ' Mise en forme de la cellule
                    With Worksheets(NomNewSheet).Range("B7").Offset(y, x)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                    End With
                Else
                    Worksheets(NomNewSheet).Range("B7").Offset(y, x).Value = "X"
                    With Worksheets(NomNewSheet).Range("B7").Offset(y, x)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                    End With
                End If
            End If
            x = x + 1
        Wend
        Z = PremDomSyn()
        Dercolonne = Range("XFD5").End(xlToLeft).Column
        ' Remplissage des stages
        ' Parcours de chaque colonne stage de la synthèse
        While Z <= Dercolonne
        LiDebTab = 4
            ' Parcours de chaques lignes de stage de la table
            While LiDebTab <= DerLiTable
                ' Test code stage de la ligne dans la table = code stage de la colonne en question de la synthèse
                If Worksheets("Table").Range("E" & LiDebTab).Value = Cells(6, Z).Value Then
                    ColBDD = PremDomBDD
                    ' Parcours de chaque colonne de la BDD pour voir si l'agent à les CTs requisent pour annimer le stage et son niveau
                    While ColBDD <= DernColBDD
                        ' Test code CTs dans la table = code CTs dans la BDD
                        If Worksheets("Table").Range("F" & LiDebTab).Value = Worksheets("BDD").Cells(8, ColBDD).Value Then
                            ' Test et écrit, dans la cellule de la synthèse, le niveau à l'aide des if suivants et est mis à jour si le niveau est inférieur
                            If Worksheets("BDD").Cells(10, ColBDD).Offset(y, 2).Value <> "" And CDate(Worksheets("BDD").Cells(10, ColBDD).Offset(y, 2).Value) < CDate(DateSynF) And (Cells(7 + y, Z) = "" Or Cells(7 + y, Z).Value = "XX") Then
                                Cells(7 + y, Z).Value = "XX"
                                With Cells(7 + y, Z)
                                .HorizontalAlignment = xlCenter
                                .VerticalAlignment = xlCenter
                                .WrapText = False
                                .Orientation = 0
                                .AddIndent = False
                                .IndentLevel = 0
                                .ShrinkToFit = False
                                .ReadingOrder = xlContext
                                .MergeCells = False
                                End With
                            ElseIf Worksheets("BDD").Cells(10, ColBDD).Offset(y, 1).Value <> "" And CDate(Worksheets("BDD").Cells(10, ColBDD).Offset(y, 1).Value) < CDate(DateSynF) And (Cells(7 + y, Z) = "" Or Cells(7 + y, Z).Value = "XX" Or Cells(7 + y, Z).Value = "X") Then
                                Cells(7 + y, Z).Value = "X"
                                With Cells(7 + y, Z)
                                .HorizontalAlignment = xlCenter
                                .VerticalAlignment = xlCenter
                                .WrapText = False
                                .Orientation = 0
                                .AddIndent = False
                                .IndentLevel = 0
                                .ShrinkToFit = False
                                .ReadingOrder = xlContext
                                .MergeCells = False
                                End With
                            ElseIf Worksheets("BDD").Cells(10, ColBDD).Offset(y, 0).Value <> "" And CDate(Worksheets("BDD").Cells(10, ColBDD).Offset(y, 0).Value) < CDate(DateSynF) And (Cells(7 + y, Z) = "" Or Cells(7 + y, Z).Value = "XX" Or Cells(7 + y, Z).Value = "X" Or Cells(7 + y, Z).Value = "P") Then
                                Cells(7 + y, Z).Value = "P"
                                With Cells(7 + y, Z)
                                .HorizontalAlignment = xlCenter
                                .VerticalAlignment = xlCenter
                                .WrapText = False
                                .Orientation = 0
                                .AddIndent = False
                                .IndentLevel = 0
                                .ShrinkToFit = False
                                .ReadingOrder = xlContext
                                .MergeCells = False
                                End With
                            ElseIf Worksheets("BDD").Cells(10, ColBDD).Offset(y, 2).Value = "" And Worksheets("BDD").Cells(10, ColBDD).Offset(y, 1).Value = "" And Worksheets("BDD").Cells(10, ColBDD).Offset(y, 0).Value = "" Then
                                Cells(7 + y, Z).Value = ""
                                GoTo 5
                            End If
                        End If
                    ColBDD = ColBDD + 3
                    Wend
                End If
            LiDebTab = LiDebTab + 1
            Wend
5        Z = Z + 1
        Wend
4        y = y + 1
    Wend
 
 
End Function

Si le tableau peut me permettre de gagner en efficacité, c'est une bonne idée.

Cordialement,
Ltspitfire

**Nico Chg** · 21/01/2015, 12h14

Re-Bonjour,

Pourquoi toutes ces mises en formes de cellules ? Effectivement, ça prend du temps, car Excel recalcule énormément de chose lorsque tu travaille directement sur la feuille, mais lors de mise en forme, pas trop le choix, je pense.

Sinon, je peux te proposer une autre alternative. Tu remplie avec une première macro tes "X" et tes "XX" et autre valeurs, sans mise en forme, puis tu fais une mise en forme conditionnel après ?

**Ltspitfire** · 21/01/2015, 12h20

Merci de te pencher sur mon problème.

Je n'ai pas bien compris lorsque tu as dis : "mais lors de mise en forme, pas trop le choix, je pense."

Oui bonne idée, j'essaie en effectuant la mise en forme à la fin et je te redis.

Cordialement,
Ltspitfire

**Ltspitfire** · 21/01/2015, 13h46

Re,

En faisant la mise en forme à la fin je gagne 10 secondes.
Je vais devoir passer par des tableaux, je vais regarder le tuto que tu m'as passé.

Comment ferais-tu ?

Cordialement,
Ltspitfire

Optimisation temps execution d'une macro [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager