Optimisation de code

**Stanler** · 03/02/2016, 14h24

Bonjour à tous !

J'ai rédigé un code qui fonctionne mais qui dure très longtemps ! Voici les deux parties du code :
Je me suis aidé du forum pour le rédiger et corriger mes erreurs, mais je dois en avoir laissé quelques unes :S

Si vous pouvez m'expliquer ce qui ne va pas dans ce code, j'aimerai comprendre mes erreurs pour les corriger.

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
Sub JdeP()
Dim T As Double
    T = Timer
    'affiche le message d'attente
    Userform2.Show 0
    Userform2.Repaint
        'Arrêt des applications suivantes pour l'accélération de la macro
        With Application
            .Cursor = xlWait
            .DisplayAlerts = False
            .ScreenUpdating = False
            .DisplayStatusBar = False
            .Calculation = xlCalculationManual
        End With
        'Nettoyage de la page "J P"
        With Sheets("J P")
            .Select
            .Cells.Delete Shift:=xlUp
            .Cells.ClearContents
        End With
    'Copie des données de la BDD vers J P
    Sheets("BDD").Cells.Copy Destination:=Sheets("J P").Cells
    'Positionnement de Excel dans J P
    Sheets("J P").Range("A1").Select
    Sheets("J P").Columns("T:T").NumberFormat = "0.00"
        'Transforme la plage en tableau
        Dim Ws As Worksheet
        Dim NomTable As String
        NomTable = "Table1"
        Set Ws = Worksheets("J P")
            With Ws
                .ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = NomTable
                .ListObjects(NomTable).TableStyle = "TableStyleLight9"
            End With
                'Compte le nombre de lignes de la Table1
                nblignes = Range("Table1").Rows.Count + 1
            'Détermine CHC comme le nombre de la ligne en cours de traitement
            For chc = 2 To nblignes
                'Variable a = Ligne chc ET colonne numéro 13
                a = CStr(Cells(chc, 13))
                'Variable b = Ligne chc ET colonne numéro 31
                b = CStr(Cells(chc, 31))
                c = CStr(Cells(chc, 20))
                d = CStr(Cells(chc, 27))
                'SI cellule(ligne chc, colonne n°20) est vide, alors = 100
                If c = 0 Or c = Empty Or c = Null Then
                    Cells(chc, 20) = "100"
                End If
                'SI Cellule A = 499040000, alors, Cellules(LigneCHC et Colonne n°20) = 100
                If a = "499040000" Then
                    Cells(chc, 20) = "100"
                    'colorie la cellule en fond vert
                    Cells(chc, 20).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                'SI A = 1058020000 ou 1058040000 ou 652040000 ou15020000, alors Cellules(lignechc, colonne n°20) = 50
                ElseIf a = "1058020000" Or a = "1058040000" Or a = "652040000" Or a = "15020000" Then
                    Cells(chc, 20) = "50"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 20).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                'Si a = 499010000 ou 499020000 ou 1577010000 ou 500910000 ou 500010000, alors Cellules(lignechc, colonne n°27 = HP
                ElseIf a = "499010000" Or a = "499020000" Or a = "1577010000" Or a = "500910000" Or a = "500010000" Then
                    Cells(chc, 27) = "HP"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 27).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                    'alors, cellule(lignechc, colonne n°20) = 0
                    Cells(chc, 20) = "0"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 20).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                'SI a = 500900000 ET b = CRHURPRDAC alors, Cellules(lignes chc, colonne n°20) = 0
                ElseIf a = "500900000" And b = "CRHURPRDAC" Then
                    Cells(chc, 20) = "0"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 20).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                    'alors cellule(ligne chc, colonne n°27)
                    Cells(chc, 27) = "HP"
                    Cells(chc, 27).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                End If
                'SI Cellule(ligne chc, colonne n°20) = "85.71" alors cellule (ligne chc, colonne n°20) = 80
                If c = "85.71" Then
                    Cells(chc, 20) = "80"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 20).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                End If
                'SI cellule(ligne chc, colonne n°41) est vide ET cellule(ligne chc, colonne n°42) est vide ET cellule(ligne chc, colonne n°43) est vide, alors cellule(ligne chc, colonne n°20 = 0
                If Cells(chc, 41) = "" And Cells(chc, 42) = "" And Cells(chc, 43) = "" Then
                    Cells(chc, 20) = "0"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 20).Select
                       With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                    ',alors cellule(ligne chc, colonne n°27) = HP
                    Cells(chc, 27) = "HP"
                    'Colorie le fond de la cellule en vert
                    Cells(chc, 27).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                End If
                If d = Empty Or d = Null Then
                    Cells(chc, 27).Value = Cells(chc, 26).Value
                'SI cellule(ligne chc, colonne n°27) est vide alors Cellule(ligne chc, colonne n°27) est égal à cellule (ligne chc, colonne n°26)
                End If
                If c = "0" Then
                    Cells(chc, 27) = "HP"
                    Cells(chc, 27).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                End If
            Next chc
            For varble1 = 2 To nblignes
                If Cells(varble1, 20) = "0" Then
                    Cells(varble1, 27) = "HP"
                    Cells(varble1, 27).Select
                        With Selection.Interior
                            .Pattern = xlSolid
                            .PatternColorIndex = xlAutomatic
                            .Color = 10092288
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                End If
            Next varble1
            Set a = Nothing
            Set b = Nothing
            Set c = Nothing
            Set d = Nothing
            Set nblignes = Nothing
            Userform2.Hide
    Call Suite
 
 
                        Sheets("Proprietes macro").Range("B2") = Application.Round((Timer - T), 5)
                            Sheets("Proprietes macro").Range("C2") = Format(Now, "dd/mm/yyyy")
                                Sheets("Proprietes macro").Range("D2") = Hour(Time) & ":" & Minute(Time) & ":" & Second(Time)
                                    Sheets("Proprietes macro").Range("G1").FormulaR1C1 = "=AVERAGE(R[1]C[-5]:R[3]C[-5])"
                                        Sheets("Proprietes macro").Protect "Protectionfeuille753", True, True, True
                                            Application.DisplayAlerts = False
                                                ThisWorkbook.Save
 
    'Réactive les applications d'excel.
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .CutCopyMode = False
        .StatusBar = False
        .DisplayAlerts = True
        .Cursor = xlDefault
    End With
'Se positionne sur la feuille TabCroDyn
Sheets("TabCroDyn").Select
    'Affiche l'UserForm1
    Unload Userform2
    UserForm1.Show 0
End Sub

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
Sub Suite()
    'Réactive les applications nécessaires à la reprise en main de excel et la réponse à l'inputbox
    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = False
        .CutCopyMode = False
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
        'Se positionne sur la colonne CO
        Sheets("J P").Range("CO1").Select
        On Error Resume Next
        'Affiche l'input box du choix de la colonne
        Set MoisETT = Application.InputBox(Prompt:="Bonjour " & Application.UserName & Chr(13) & "Merci de cliquer sur le titre du mois pour lequel nous travaillons", Title:="Mois", Type:=8)
        On Error GoTo 0
    'Désactive les applications activées précédemment
    With Application
        .Calculation = xlManual
        .DisplayAlerts = True
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    Userform2.Show 0
    Userform2.Repaint
            'Active la feuille J P
                    Sheets("J P").Activate
                    'Extrait la colonne de la cellule sélectionnée
                    CETT= MoisETT.Column
                    'Vide les cellules CG2:CT2 jusqu'à la fin du tableau.
                    'Ecrit la formule "=T2/100"dans la colonne sélectionnée
                    'Ecrit la formule dans la colonne CT
                    With Sheets("J P")
                        .Range("CG2:CT2", Selection.End(xlDown)).ClearContents
                        .Cells(2, CETT) = "=T2/100"
                        .Range("CT2").Formula = "=RC[-78]/100"
                    End With
                    Set CETT = Nothing
                    Set MoisETT = Nothing
                    'Copie les colonnes A à F
                    'vide les cellules de G3 jusqu'à la fin
                    'Déflitre les tableaux filtrés de la feuille "TabCroDyn"
                    With Sheets("TabCroDyn")
                        .ShowAllData
                        .PivotTables("TCD").PivotCache.Refresh
                        .Columns("H:M").ClearContents
                        .Columns("H:M").FormatConditions.Delete
                        .Columns("H:M").Value = Sheets("TabCroDyn").Columns("A:F").Value
                        .Range("G3").End(xlDown).Value = ""
                        If .FilterMode = True Then .ShowAllData
                    End With
                        'Appliquer un filtre sur doublons
                        With Sheets("TabCroDyn").Columns("I:I")
                        .FormatConditions.AddUniqueValues
                        .FormatConditions(Sheets("TabCroDyn").Columns("I:I").FormatConditions.Count).SetFirstPriority
                        .FormatConditions(1).DupeUnique = xlDuplicate
                        End With
                        With Sheets("TabCroDyn").Columns("I:I").FormatConditions(1).Font
                            .Color = -16383844
                            .TintAndShade = 0
                        End With
                        With Sheets("TabCroDyn").Columns("I:I").FormatConditions(1).Interior
                            .PatternColorIndex = xlAutomatic
                            .Color = 13551615
                            .TintAndShade = 0
                        End With
                        Sheets("TabCroDyn").Columns("I:I").FormatConditions(1).StopIfTrue = False
                With Sheets("TabCroDyn").Columns("I:I")
                    .FormatConditions.AddUniqueValues
                    .FormatConditions(.FormatConditions.Count).SetFirstPriority
                    'Utilisez xlUnique pour identifier les valeurs uniques
                    .FormatConditions(1).DupeUnique = xlDuplicate
                    .FormatConditions(1).Interior.Color = RGB(255, 199, 206)
                End With
                On Error Resume Next
                ActiveSheet.ShowAllData
        ActiveWorkbook.Worksheets("TabCroDyn").AutoFilter.Sort.SortFields.Add(Columns("I:I"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
        = RGB(255, 199, 206)
        ActiveSheet.Range("$H$3:$M$1562").AutoFilter Field:=2, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
 
 
 
        'Inscrit une formule dans la colonne
        CComp = Rows("1:1").Find("Cpodir", , xlValues, xlWhole, , , False).Column
        Columns(CComp).Columns.ClearContents
        Cells(1, CComp) = "Cpodir"
        Cells(2, CComp).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;34;FAUX)"
        Set CComp = Nothing
 
 
            'Inscrit une formule dans la colonne
            CServ = Rows("1:1").Find("Service (HP)", , xlValues, xlWhole, , , False).Column
            Columns(CServ).Columns.ClearContents
            Cells(1, CServ) = "Service (HP)"
            Cells(2, CServ).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;35;FAUX)"
            Set CServ = Nothing
 
 
                'Inscrit une formule dans la colonne
                CAffc = Rows("1:1").Find("aff)", , xlValues, xlWhole, , , False).Column
                Columns(CAffc).Columns.ClearContents
                Cells(1, CAffc) = "affr (comp)"
                Cells(2, CAffc).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;38;FAUX)"
                Set CAffc = Nothing
 
 
                    'Inscrit une formule dans la colonne
                    CAffl = Rows("1:1").Find("affr(lab)", , xlValues, xlWhole, , , False).Column
                    Columns(CAffl).Columns.ClearContents
                    Cells(1, CAffl) = "affr(lab)"
                    Cells(2, CAffl).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;39;FAUX)"
                    Set CAff1 = Nothing
 
 
                        'Inscrit une formule dans la colonne
                        CNempHP = Rows("1:1").Find("N° E(HP)", , xlValues, xlWhole, , , False).Column
                        Columns(CNempHP).Columns.ClearContents
                        Cells(1, CNempHP) = "N° E(HP)"
                        Cells(2, CNempHP).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;21;FAUX)"
                        Set CNempHP = nohting
 
 
                            'Inscrit une formule dans la colonne
                            CNempnat = Rows("1:1").Find("N° E(nat)", , xlValues, xlWhole, , , False).Column
                            Columns(CNempnat).Columns.ClearContents
                            Cells(1, CNempnat) = "N° E(nat)"
                            Cells(2, CNempnat).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;22;FAUX)"
                            Set CNempnat = Nothing
 
 
                                'Inscrit une formule dans la colonne
                                CCCE = Rows("1:1").Find("Code catégorie E", , xlValues, xlWhole, , , False).Column
                                Columns(CCCE).Columns.ClearContents
                                Cells(1, CCCE) = "Code catégorie E"
                                Cells(2, CCCE).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;23;FAUX)"
                                Set CCCE = Nothing
 
 
                                    'Inscrit une formule dans la colonne
                                    CLCE = Rows("1:1").Find("Lib Catégorie E", , xlValues, xlWhole, , , False).Column
                                    Columns(CLCE).Columns.ClearContents
                                    Cells(1, CLCE) = "Lib Catégorie E"
                                    Cells(2, CLCE).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;24;FAUX)"
                                    Set CLCE = Nothing
 
                                        'Inscrit une formule dans la colonne
                                        CNatbudg = Rows("1:1").Find("Nature budget", , xlValues, xlWhole, , , False).Column
                                        Columns(CNatbudg).Columns.ClearContents
                                        Cells(1, CNatbudg) = "Nature budget"
                                        Cells(2, CNatbudg).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;27;FAUX)"
                                        Set CNatbudg = Nothing
 
                                            'Inscrit une formule dans la colonne
                                            CTypocc = Rows("1:1").Find("Type Occupation", , xlValues, xlWhole, , , False).Column
                                            Columns(CTypocc).Columns.ClearContents
                                            Cells(1, CTypocc) = "Type Occupation"
                                            Cells(2, CTypocc).FormulaLocal = "=RECHERCHEV(A2;'Base au 15 du mois'!A:AO;30;FAUX)"
                                            Set CTypocc = Nothing
 
        'Active et selectionne la feuille "Base au 15 du mois"
        Sheets("Base au 15 du mois").Select
        'Créé un format de tableau
        Dim Basedu15 As Worksheet
        Dim Tabledu15 As String
        Tabledu15 = "Table2"
        Set Basedu15 = Worksheets("Base au 15 du mois")
            With Worksheets("Base au 15 du mois")
                .ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = Tabledu15
                .ListObjects(Tabledu15).TableStyle = "TableStyleLight1"
            End With
                        If Not Sheets("Base au 15 du mois").Range("AL1") = "Cporech" Then
                           With Sheets("Base au 15 du mois")
                                .Activate
                                .Columns("AL:AL").Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                                .Columns("AL:AL").Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                                .Range("AL1") = "Cporech"
                                .Range("AM1") = "labrech"
                            End With
                                'Ecrit les formules dans les colonnes crées
                            Sheets("Base au 15 du mois").Range("AL2").Activate
                                Sheets("Base au 15 du mois").Range("AL2").FormulaLocal = "=SI(ESTNA(RECHERCHEV($A2;Affs!A:I;6;FAUX));"""";RECHERCHEV($A2;Affs!A:I;6;FAUX))"
                                Sheets("Base au 15 du mois").Range("AM2").FormulaLocal = "=SI(ESTNA(RECHERCHEV($A2;Affs!A:I;7;FAUX));"""";(RECHERCHEV($A2;Aff!A:I;7;FAUX)))"
                        'Supprime le tableau
                        Sheets("Base au 15 du mois").ListObjects("Table2").Unlist
                        End If
        'active la feuille J P
        Sheets("J P").Activate
            'Compte le nombre de lignes
            nblignes = Range("Table1").Rows.Count + 1
            'Détermine CHC comme le nombre de la ligne en cours de traitement
            'Met en place une boucle pour changer les Cptdiren fonction des Centres de Co
            For chc = 2 To nblignes
                cc = CStr(Cells(chc, 31))
                eotp = CStr(Cells(chc, 35))
                comdir = CStr(Cells(chc, 101))
                servhp = CStr(Cells(chc, 102))
                If cc = "C00ACS003" Then
                    comdir.ClearContents
                    comdir = "1111"
                End If
                If cc = "C00CLA001" Then
                    comdir.ClearContents
                    comdir = "2222"
                End If
                If cc = "C00DOC001" Then
                    comdir.ClearContents
                    comdir = "3333"
                End If
                If cc = "C00MED002" Then
                    comdir.ClearContents
                    servhp.ClearContents
                    comdir = "44fse44" And servhp = "5555- OIP"
                End If
                If cc = "C00MOY003" Then
                    comdir.ClearContents
                    comdir = "8888VA"
                End If
                If cc = "C00REU001" Then
                    comdir.ClearContents
                    comdir = "9fest999" And servhp = "9999se- OIP"
                End If
                If cc = "C00RHU002" Then
                    comdir.ClearContents
                    comdir = "741" And servhp = "7415"
                End If
                If cc = "C00RHU002F" Then
                    comdir.ClearContents
                    comdir = "7458" And servhp = "7865"
                End If
                If cc = "C00VIE***" Then
                    comdir.ClearContents
                    comdir = "698741" And servhp = "741"
                End If
                If cc = "C01RHU001H" Or "C01RHU001V" Then
                    comdir.ClearContents
                    comdir = "htrt"
                End If
                If cc = "C02RHU001H" Or "C02RHU001V" Then
                    comdir.ClearContents
                    comdir = "354"
                End If
                If cc = "C03RHU001H" Or "C03RHU001V" Then
                    comdir.ClearContents
                    comdir = "879"
                End If
                If cc = "C04RHU001H" Or "C04RHU001V" Then
                    comdir.ClearContents
                    comdir = "684648"
                End If
                If cc = "C06RHU001H" Or "C06RHU001V" Then
                    comdir.ClearContents
                    comdir = "13164"
                End If
                If cc = "C07ENS002" And eotp = "12RADEMA" Then
                    comdir.ClearContents
                    comdir = "frgez" And servhp = "ewrs"
                End If
                If cc = "C07ENS002" And eotp = "12RPFSI0" Then
                    comdir.ClearContents
                    comdir = "eaztf" And servhp = "eeeeee"
                End If
                If cc = "C07RHU001H" Or "C07RHU001V" Then
                    comdir.ClearContents
                    comdir = "zfwezs"
                End If
                If cc = "C08RHU001H" Or "C08RHU001V" Then
                    comdir.ClearContents
                    comdir = "gezszew"
                End If
                If cc = "C09RHU001H" Or "C09RHU001V" Then
                    comdir.ClearContents
                    comdir = "aqzesd"
                End If
                If cc = "C10RHU001H" Or "C10RHU001V" Then
                    comdir.ClearContents
                    comdir = "zzesdf
                End If
                If cc = "C11RHU001H" Or "C11RHU001V" Then
                    comdir.ClearContents
                    comdir = "9g61rd"
                End If
            Next chc
            Set chc = Nothing
            Set cc = Nothing
            Set comdir = Nothing
            Set eotp = Nothing
            Set servhp = Nothing
            Set nblignes = Nothing
                            'Filtre les doublons de TabCroDyn sur la colonne I3
                            Sheets("TabCroDyn").Range("I3").CurrentRegion.AutoFilter Field:=2, Criteria1:=RGB(255, _
                                199, 206), Operator:=xlFilterCellColor
                                    'Enléve le tableau du J P
                                    Sheets("J P").ListObjects("Table1").Unlist
                                    'Filtre sur Colonne 27 = E ou P(on ne regarde pas les HP)
                                    Sheets("J P").Range("A1").AutoFilter Field:=27, Criteria1:= _
                                        "=E", Operator:=xlOr, Criteria2:="=P"
     Application.CutCopyMode = False
        Sheets("Proprietes macro").Visible = xlSheetHidden
            Sheets("Proprietes macro").Unprotect "Motdepassedifficile123"
                Sheets("Proprietes macro").Rows("2:2").EntireRow.Insert Shift:=xlDown
                    Sheets("Proprietes macro").Range("A2") = Application.UserName
End Sub

Merci de votre aide !
Par ailleurs, je viens de m'aperçevoir que cette partie là ne fonctionne pas :

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
            For chc = 2 To nblignes
                cc = CStr(Cells(chc, 31))
                eotp = CStr(Cells(chc, 35))
                comdir = CStr(Cells(chc, 101))
                servhp = CStr(Cells(chc, 102))
                If cc = "C00ACS003" Then
                    comdir.ClearContents
                    comdir = "1111"
                End If
                If cc = "C00CLA001" Then
                    comdir.ClearContents
                    comdir = "2222"
                End If
                If cc = "C00DOC001" Then
                    comdir.ClearContents
                    comdir = "3333"
                End If
                If cc = "C00MED002" Then
                    comdir.ClearContents
                    servhp.ClearContents
                    comdir = "44fse44" And servhp = "5555- OIP"
                End If
                If cc = "C00MOY003" Then
                    comdir.ClearContents
                    comdir = "8888VA"
                End If
                If cc = "C00REU001" Then
                    comdir.ClearContents
                    comdir = "9fest999" And servhp = "9999se- OIP"
                End If
                If cc = "C00RHU002" Then
                    comdir.ClearContents
                    comdir = "741" And servhp = "7415"
                End If
                If cc = "C00RHU002F" Then
                    comdir.ClearContents
                    comdir = "7458" And servhp = "7865"
                End If
                If cc = "C00VIE***" Then
                    comdir.ClearContents
                    comdir = "698741" And servhp = "741"
                End If
                If cc = "C01RHU001H" Or "C01RHU001V" Then
                    comdir.ClearContents
                    comdir = "htrt"
                End If
                If cc = "C02RHU001H" Or "C02RHU001V" Then
                    comdir.ClearContents
                    comdir = "354"
                End If
                If cc = "C03RHU001H" Or "C03RHU001V" Then
                    comdir.ClearContents
                    comdir = "879"
                End If
                If cc = "C04RHU001H" Or "C04RHU001V" Then
                    comdir.ClearContents
                    comdir = "684648"
                End If
                If cc = "C06RHU001H" Or "C06RHU001V" Then
                    comdir.ClearContents
                    comdir = "13164"
                End If
                If cc = "C07ENS002" And eotp = "12RADEMA" Then
                    comdir.ClearContents
                    comdir = "frgez" And servhp = "ewrs"
                End If
                If cc = "C07ENS002" And eotp = "12RPFSI0" Then
                    comdir.ClearContents
                    comdir = "eaztf" And servhp = "eeeeee"
                End If
                If cc = "C07RHU001H" Or "C07RHU001V" Then
                    comdir.ClearContents
                    comdir = "zfwezs"
                End If
                If cc = "C08RHU001H" Or "C08RHU001V" Then
                    comdir.ClearContents
                    comdir = "gezszew"
                End If
                If cc = "C09RHU001H" Or "C09RHU001V" Then
                    comdir.ClearContents
                    comdir = "aqzesd"
                End If
                If cc = "C10RHU001H" Or "C10RHU001V" Then
                    comdir.ClearContents
                    comdir = "zzesdf
                End If
                If cc = "C11RHU001H" Or "C11RHU001V" Then
                    comdir.ClearContents
                    comdir = "9g61rd"
                End If
            Next chc
            Set chc = Nothing
            Set cc = Nothing
            Set comdir = Nothing
            Set eotp = Nothing
            Set servhp = Nothing
            Set nblignes = Nothing

Auriez vous une idée ?

**parmi** · 03/02/2016, 19h52

Bonjour,

C'est un peu normal que ça prenne du temps vu tous les changements graphiques que tu apportes... (couleurs de cellules, TCD, MFC,...)
Et tu ne mentionnes pas combien de temps elle roule.

Entre autres, évite les Select qui ralentissent pour rien.

Quelques idées:

Code :

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

1
2
3
 
    Userform2.Show 0
    Userform2.Repaint  '<<< pas nécessaire, à mon avis

With Sheets("J P")
.Select
.Cells.Delete Shift:=xlUp
.Cells.ClearContents
End With

pourrait devenir

Code :

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

        Sheets("J P").Cells.Delete

Plutôt que de mettre un format à toute une colonne, fais-le pour les cellules nécessaires

Sheets("J P").Columns("T:T").NumberFormat = "0.00"

**Stanler** · 04/02/2016, 12h39

Bonjour Parmi, merci pour ton aide ^^
Ça doit surement te rappeler un précédent sujet sur lequel tu m'avais aidé

Pour le temps d'exécution, ça dépend des machines qui lancent la macro, mais généralement c'est autour de 15 minutes parce qu'il y a quand même plus de 4000 lignes à traiter.

Merci pour tes améliorations, je vais apporter ces changements dans le code

Plutôt que de mettre un format à toute une colonne, fais-le pour les cellules nécessaires

Sheets("J P").Columns("T:T").NumberFormat = "0.00"

Tu veux dire que je devrai plutôt appliquer ce format aux cellules non vides de la colonne T ?

Aussi, aurais tu une idée pour ce For next qui ne fonctionne pas ? :S :

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
            For chc = 2 To nblignes
                cc = CStr(Cells(chc, 31))
                eotp = CStr(Cells(chc, 35))
                comdir = CStr(Cells(chc, 101))
                servhp = CStr(Cells(chc, 102))
                If cc = "C00ACS003" Then
                    comdir.ClearContents
                    comdir = "1111"
                End If
                If cc = "C00CLA001" Then
                    comdir.ClearContents
                    comdir = "2222"
                End If
                If cc = "C00DOC001" Then
                    comdir.ClearContents
                    comdir = "3333"
                End If
                If cc = "C00MED002" Then
                    comdir.ClearContents
                    servhp.ClearContents
                    comdir = "44fse44" And servhp = "5555- OIP"
                End If
                If cc = "C00MOY003" Then
                    comdir.ClearContents
                    comdir = "8888VA"
                End If
                If cc = "C00REU001" Then
                    comdir.ClearContents
                    comdir = "9fest999" And servhp = "9999se- OIP"
                End If
                If cc = "C00RHU002" Then
                    comdir.ClearContents
                    comdir = "741" And servhp = "7415"
                End If
                If cc = "C00RHU002F" Then
                    comdir.ClearContents
                    comdir = "7458" And servhp = "7865"
                End If
                If cc = "C00VIE***" Then
                    comdir.ClearContents
                    comdir = "698741" And servhp = "741"
                End If
                If cc = "C01RHU001H" Or "C01RHU001V" Then
                    comdir.ClearContents
                    comdir = "htrt"
                End If
                If cc = "C02RHU001H" Or "C02RHU001V" Then
                    comdir.ClearContents
                    comdir = "354"
                End If
                If cc = "C03RHU001H" Or "C03RHU001V" Then
                    comdir.ClearContents
                    comdir = "879"
                End If
                If cc = "C04RHU001H" Or "C04RHU001V" Then
                    comdir.ClearContents
                    comdir = "684648"
                End If
                If cc = "C06RHU001H" Or "C06RHU001V" Then
                    comdir.ClearContents
                    comdir = "13164"
                End If
                If cc = "C07ENS002" And eotp = "12RADEMA" Then
                    comdir.ClearContents
                    comdir = "frgez" And servhp = "ewrs"
                End If
                If cc = "C07ENS002" And eotp = "12RPFSI0" Then
                    comdir.ClearContents
                    comdir = "eaztf" And servhp = "eeeeee"
                End If
                If cc = "C07RHU001H" Or "C07RHU001V" Then
                    comdir.ClearContents
                    comdir = "zfwezs"
                End If
                If cc = "C08RHU001H" Or "C08RHU001V" Then
                    comdir.ClearContents
                    comdir = "gezszew"
                End If
                If cc = "C09RHU001H" Or "C09RHU001V" Then
                    comdir.ClearContents
                    comdir = "aqzesd"
                End If
                If cc = "C10RHU001H" Or "C10RHU001V" Then
                    comdir.ClearContents
                    comdir = "zzesdf
                End If
                If cc = "C11RHU001H" Or "C11RHU001V" Then
                    comdir.ClearContents
                    comdir = "9g61rd"
                End If
            Next chc
            Set chc = Nothing
            Set cc = Nothing
            Set comdir = Nothing
            Set eotp = Nothing
            Set servhp = Nothing
            Set nblignes = Nothing

**parmi** · 04/02/2016, 15h32

Tu veux dire que je devrai plutôt appliquer ce format aux cellules non vides de la colonne T ?

Il faudrait que tu trouves le nombre de ligne de ton tableau et affecter les formats à ce nombre de lignes seulement plutôt qu'à toute la colonne

Ici, ça ne sert à rien d'effacer auparavant puisque tu écrases à la ligne suivante

Code :

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

1
2
3
4
If cc = "C00ACS003" Then
     comdir.ClearContents  '<<< pas nécessaire
     comdir = "1111"
End If

Ici, ça ne devrait pas fonctionner

If cc = "C00MED002" Then
comdir.ClearContents
servhp.ClearContents
comdir = "44fse44" And servhp = "5555- OIP"
End If

Essaie plutôt

Code :

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

1
2
3
4
If cc = "C00MED002" Then
       comdir = "44fse44"
       servhp = "5555- OIP"
End If

Ici, il manque un guillemet à la fin, mais normalement VBA devrait l'ajouter par défaut (?!)

If cc = "C10RHU001H" Or "C10RHU001V" Then
comdir.ClearContents
comdir = "zzesdf '<<< manque un guillemet ?!
End If

Finalement, tous les Set xyz = Nothing ne servent à rien si tu ne les a pas "Setter" auparavant
On utilise cette méthode lorsqu'on écrit par exemple

Code :

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

1
2
3
4
Dim MonObjet
Set MonObjet = Machin
' le code
Set MonObjet = Nothing ' à la fin de procédure

Optimisation de code

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager