Optimisation temps execution d'une macro

**Nico Chg** · 22/01/2015, 14h58

Re-bonjour,

J'ai téléchargé ton fichier, et j'ai changer les While / Wend par des For, sans utiliser de variable tableau. Je voulais préparer le terrain, mais au lancement de la macro, ça à pris moins d'une seconde.

Je te redonne le code que j'ai utiliser :

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)
 
'--- Déclaration des variables ---
 
Dim DerLi As Single
Dim DerLiTable As Single
Dim DernColBDD As Single
Dim X As Single, Y As Single, Z As Single
 
Dim DateSynF As String
 
Dim PremDomBDD As Variant
'Je ne connais pas la fonction PremDom(), typage par défaut alors
 
Dim WsOnglet As Worksheet
Dim WsTable As Worksheet
Dim WsBDD As Worksheet
 
'--- Instanciation des objets ---
 
Set WsOnglet = Worksheets(NomNewSheet)
Set WsTable = Worksheets("Table")
Set WsBDD = Worksheets("BDD")
 
'--- Initialisation des variables ---
 
DateSynF = Format("01/" & DateSyn, "MM/YYYY")
 
DerLi = WsOnglet.Range("A" & Rows.Count).End(xlUp).Row
DerLiTable = WsTable.Range("E" & Rows.Count).End(xlUp).Row
DernColBDD = WsBDD.Range("XFD9").End(xlToLeft).Column
 
WsOnglet.Activate
 
PremDomBDD = PremDom()
 
'--- Développement ---
 
Application.ScreenUpdating = False
 
' Parcours de chaque agent
For Y = 0 To DerLi - 6
    If CDate(WsBDD.Range("D10").Offset(Y, 0).Value) < CDate(DateSyn) And WsBDD.Range("D10").Offset(Y, 0).Value <> "" Then
        GoTo SBreak
    End If
 
    For X = 0 To 11
        'Remplisage des x
 
        If WsBDD.Range("E10").Offset(Y, X).Value <> "" Then
 
            DateTest = Format(WsBDD.Range("E10").Offset(Y, X).Value, "MM/YYYY")
 
            If CDate(DateTest) > CDate(DateSynF) Then
                WsOnglet.Range("B7").Offset(Y, X).Value = "P"
            Else
                WsOnglet.Range("B7").Offset(Y, X).Value = "X"
            End If
        End If
    Next X
 
    Dercolonne = WsOnglet.Range("XFD5").End(xlToLeft).Column
    ' Remplissage des stages
    ' Parcours de chaque colonne stage de la synthèse
 
    For Z = PremDomSyn() To Dercolonne
 
        ' Parcours de chaques lignes de stage de la table
        For LiDebTab = 4 To DerLiTable
 
            ' Test code stage de la ligne dans la table = code stage de la colonne en question de la synthèse
            If WsTable.Range("E" & LiDebTab).Value = Cells(6, Z).Value Then
 
                ' Parcours de chaque colonne de la BDD pour voir si l'agent à les CTs requisent pour annimer le stage et son niveau
                For ColBDD = PremDomBDD To DernColBDD Step 3
 
                    ' Test code CTs dans la table = code CTs dans la BDD
                    If WsTable.Range("F" & LiDebTab).Value = WsBDD.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 WsBDD.Cells(10, ColBDD).Offset(Y, 2).Value <> "" And CDate(WsBDD.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"
                        ElseIf WsBDD.Cells(10, ColBDD).Offset(Y, 1).Value <> "" And CDate(WsBDD.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"
                        ElseIf WsBDD.Cells(10, ColBDD).Offset(Y, 0).Value <> "" And CDate(WsBDD.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"
                        ElseIf WsBDD.Cells(10, ColBDD).Offset(Y, 2).Value = "" And WsBDD.Cells(10, ColBDD).Offset(Y, 1).Value = "" And WsBDD.Cells(10, ColBDD).Offset(Y, 0).Value = "" Then
                            Cells(7 + Y, Z).Value = ""
                            GoTo FBreak
                        End If
                    End If
 
                Next ColBDD
            End If
 
        Next LiDebTab
FBreak:
    Next Z
SBreak:
Next Y
 
DerLi = WsOnglet.Range("A" & Rows.Count).End(xlUp).Row
DerCol = WsOnglet.Range("XFD6").End(xlToLeft).Column
 
'    Mise en forme de la cellule
With WsOnglet
    With .Range("B7", .Cells(DerLi, DerCol))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End With
 
Application.ScreenUpdating = True
 
End Function

J'ai déclarer tes variables en têtes de modules, et déclarer des objets Worksheets, pour plus de clarté dans la suite du code.

Quelques conseils : N'utilise pas Range tous seul, précise lui l'objet lui étant rattaché, ça a planté chez moi à cause de ça.

Je n'ai pas du tout changer ton algorithme (je n'ai pas spécialement cherché à comprendre ce que tu faisais. Reviens vers moi si tu veux utiliser des variables tableaux, ou plus de précision sur le code.

**Ltspitfire** · 22/01/2015, 15h09

Re,

Chez moi aussi la macro prend moins d'une seconde, j'ai seulement mis une dizaine de ligne dans la BDD pour l'exemple. Cependant lorsque je passe sur la vrai base ( 3000 lignes pour l'instant mais ca devrait monter à 10 000) la macro prend 2 min.

Si tu veux je peux t'envoyer une BDD plus conséquente ( la BDD original est confidentielle).