Optimisation de la vitesse de mon code

Version imprimable

Bonjourà tous

j'aimerai réduire le temps d'exécution de ma macro
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 n = 1 Do If Feuil1.Cells(i, n).Interior.Color <> RGB(255, 255, 255) Then With Feuil6 .Cells(k, 1).Value = i ' i coreespond au nombre de ligne de la feuille1 End With k = k + 1 Exit Do Else n = n + 1 End If Loop Until n = 42 '42 c'est le nombre de colonne à traiter: mais on peut tester sur toute la ligne
Ce code permet d'écrire les numéros de lignes en feuille 6 lorsque la couleur d'une cellule n'est pas blanche

Seulement le temps d'éxécution de ma macro est beaucoup plus long et j'aimerai savoir si il n'y aurait pas un moyen plus rapide

J'ai essayé avec rows:
Code:

1 2 3 4 5 If Rows(i) <> RGB(255, 255, 255) Then Feuil6.Cells(k, 1).Value = i k = k + 1 End If
bien entendu ça ne marche pas

Merci d'avance pour vos solutions proposées
Cordialment

08/02/2011, 10h24
Godzestla

Bonjour,

c'est peut-être juste du au réaffichage :

Ajoute en début de code :

Code:

Application.ScreenUpdating = False

et en fin

Code:

Application.ScreenUpdating = True

Cela devrait déjà bien améliorer la vitesse.

Bonne idée Godzestla, met je l'ai déjà mis, le code que j'ai poster n'est qu'une petite partie de ma macro ...

sans ce le petit bout de code que j'ai poster elle dure 30 seconde environ et avec celui ci plus d'une minutes...
C'est pour ça que je cherche une solution:

Je pose mon code en entier si ça peut aider à faire avancer le schmilblick

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
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
 
Option Explicit
Public compte_false As Integer
Public compte_miss As Integer
 
Sub Controle_données()
Dim Nb_ligne As Long, i As Long
Dim n As Long
Dim k As Long
k = 1
 
Feuil6.Cells.ClearFormats
Feuil6.Cells.ClearContents
 
 
Application.ScreenUpdating = False
 
With Feuil1
    Nb_ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Rows("2:" & Nb_ligne)
        .ClearComments
        .ClearFormats
    End With
    compte_false = 0
    compte_miss = 0
 
    For i = 2 To Nb_ligne
'Tar pM
        n = Len(.Cells(i, 3).Value)
        If n > 3 Then
            .Cells(i, 3).Interior.Color = RGB(0, 0, 0)
            .Cells(i, 3).Font.Color = RGB(255, 255, 255)
            .Cells(i, 3).Font.Bold = True
            .Cells(i, 3).AddComment
            .Cells(i, 3).Comment.Text Text:="Il ne doit pas y avoir plus de 3 caractère dans cette cellule"
            compte_false = compte_false + 1
        End If
'colonne Log N
        If .Cells(i, 5) <> "C" And .Cells(i, 5) <> "S" And .Cells(i, 5) <> "G" And .Cells(i, 5) <> "" Then
            .Cells(i, 5).Interior.Color = RGB(0, 0, 0)
            .Cells(i, 5).Font.Color = RGB(255, 255, 255)
            .Cells(i, 5).Font.Bold = True
            .Cells(i, 5).AddComment
            .Cells(i, 5).Comment.Text Text:="Les caractères acceptés sont ""C"", ""S"", ""G"" et case vides "
            compte_false = compte_false + 1
        End If
'colonne Cat Marché
        If .Cells(i, 6) <> "" And Cells(i, 6) <> "Oui" Then
            .Cells(i, 6).Interior.Color = RGB(0, 0, 0)
            .Cells(i, 6).Font.Color = RGB(255, 255, 255)
            .Cells(i, 6).Font.Bold = True
            .Cells(i, 6).AddComment
            .Cells(i, 6).Comment.Text Text:="Les caractères acceptés sont ""Oui"" et case vides "
            compte_false = compte_false + 1
        End If
'Vie N
        If .Cells(i, 8) <> "" And Cells(i, 8) <> "F" And Cells(i, 8) <> "N" Then
            .Cells(i, 8).Interior.Color = RGB(0, 0, 0)
            .Cells(i, 8).Font.Color = RGB(255, 255, 255)
            .Cells(i, 8).Font.Bold = True
            .Cells(i, 8).AddComment
            .Cells(i, 8).Comment.Text Text:="Les caractères acceptés sont ""N"" ,""F"" et case vides "
            compte_false = compte_false + 1
        End If
 
'Code article
        If .Cells(i, 9) = "" Then
            .Cells(i, 9).Font.ColorIndex = 3
            .Cells(i, 9).Interior.ColorIndex = 6
            .Cells(i, 9).Font.Bold = True
            .Cells(i, 9).AddComment
            .Cells(i, 9).Comment.Text Text:="Pas de cellules vides autorisées"
            compte_miss = compte_miss + 1
        End If
'Article
        If .Cells(i, 10) = "" Then
            .Cells(i, 10).Font.ColorIndex = 3
            .Cells(i, 10).Interior.ColorIndex = 6
            .Cells(i, 10).Font.Bold = True
            .Cells(i, 10).AddComment
            .Cells(i, 10).Comment.Text Text:="Pas de cellules vides autorisées"
            compte_miss = compte_miss + 1
        End If
'Code EAN
        n = Len(.Cells(i, 13).Value)
        If n <> 13 And .Cells(i, 13) <> "" Then
            .Cells(i, 13).Interior.Color = RGB(0, 0, 0)
            .Cells(i, 13).Font.Color = RGB(255, 255, 255)
            .Cells(i, 13).Font.Bold = True
            .Cells(i, 13).AddComment
            .Cells(i, 13).Comment.Text Text:="Le code EAN doit comporté 13 caractères"
            compte_false = compte_false + 1
        End If
 
'Sig Pm
n = Len(Cells(i, 15).Value)
 
If n <> 3 And .Cells(i, 15) <> "" Then
.Cells(i, 15).Interior.Color = RGB(0, 0, 0)
.Cells(i, 15).Font.Color = RGB(255, 255, 255)
.Cells(i, 15).Font.Bold = True
.Cells(i, 15).AddComment
.Cells(i, 15).Comment.Text Text:="Sig Pm doit comporté 3 caractères"
compte_false = compte_false + 1
 
End If
 
'marché
 
n = Len(Cells(i, 38).Value)
 
If n > 1 Then
.Cells(i, 38).Interior.Color = RGB(0, 0, 0)
.Cells(i, 38).Font.Color = RGB(255, 255, 255)
.Cells(i, 38).Font.Bold = True
.Cells(i, 38).AddComment
.Cells(i, 38).Comment.Text Text:="Seulement 1 caractère pour cette cellule"
 
compte_false = compte_false + 1
 
End If
 
 
'Domaine
 
 
n = Len(Cells(i, 39).Value)
 
If n <> 0 And n <> 2 Then
.Cells(i, 39).Interior.Color = RGB(0, 0, 0)
.Cells(i, 39).Font.Color = RGB(255, 255, 255)
.Cells(i, 39).Font.Bold = True
.Cells(i, 39).AddComment
.Cells(i, 39).Comment.Text Text:="2 caractères pour cette cellule"
compte_false = compte_false + 1
 
End If
 
'If Rows(i) <> RGB(255, 255, 255) Then
'Feuil6.Cells(k, 1).Value = i
'k = k + 1
'End If
 
n = 1
Do
If Cells(i, n).Interior.Color <> RGB(255, 255, 255) Then
    With Feuil6
        .Cells(k, 1).Value = i
    End With
    k = k + 1
    Exit Do
Else
n = n + 1
End If
 
Loop Until n = 42
 
Application.StatusBar = "Patientez: traitement effectuer à " & Int(100 * i / Nb_ligne) & " %"
 
    Next i
End With
 
Application.StatusBar = False
 
Feuil6.Activate
 
If Cells(1, 1) <> "" Then
Call misenforme 
End If
 
Application.ScreenUpdating = True
 
End Sub

08/02/2011, 10h57
Didier Gonard
Bonjour,

en premier lieu, ce qu'il faut savoir c'est par quel biais tes cellules deviennent non blanches ?
- Mise en forme manuelle ?
- MFC ?
- ?
cordialement,

Didier
08/02/2011, 10h58
Godzestla

Re,

pour améliorer la lisibilité, tu pourrais utiliser des with imbriqués.

pour ta vitesse, difficile de dire si on peut ou pas travailler sur la logique.

Mais je pense que tes nombreux accès aux cellules sont pénalisant.

Je te conseille de charger tes cellules dans 1 tableau à 2 dimensions (ligne et collone) et de faire tous les tests sur le tableau.

Quand tu as une anomalie, et uniquement dans ce cas, tu accèdes à la cellule concernée pour changer son format.

Puis tu continues à boucler sur ton tableau.

cela devrait accélérer.

Et puis, met ton

Code:

Application.ScreenUpdating = False

encore un peu plus haut.
08/02/2011, 11h29
dodo69

Ormonth , tout est automatique, les cellule ne sont plus blanche lorsque la macro detecte qu'une cellule ne correspond pas aux critères attendus, c'est dans le code que j'ai poster.

Godzestla , je ne comprend pas ce que tu veux dire , comment je peux faire un tel tableau, peux tu me donner plus d'information stp.

Merci de vos aide
Cdt

Essaies ceci

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
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
Option Explicit
Public compte_false As Integer
Public compte_miss As Integer
 
Sub Controle_données()
Dim Nb_ligne As Long, i As Long, k As Long, Cpt As Long
 
Application.ScreenUpdating = False
Feuil6.UsedRange.Clear
With Feuil1
    Nb_ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Rows("2:" & Nb_ligne)
        .ClearComments
        .ClearFormats
    End With
    compte_false = 0
    compte_miss = 0
    For i = 2 To Nb_ligne
    'Tar pM
        With .Cells(i, 3)
            If Len(.Value) > 3 Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Il ne doit pas y avoir plus de 3 caractère dans cette cellule"
                compte_false = compte_false + 1
            End If
        End With
        'colonne Log N
        With .Cells(i, 5)
            If .Value <> "C" And .Value <> "S" And .Value <> "G" And .Value <> "" Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Les caractères acceptés sont ""C"", ""S"", ""G"" et case vides "
                compte_false = compte_false + 1
            End If
        End With
        'colonne Cat Marché
        With .Cells(i, 6)
            If .Value <> "" And .Value <> "Oui" Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Les caractères acceptés sont ""Oui"" et case vides "
                compte_false = compte_false + 1
            End If
        End With
        'Vie N
        With .Cells(i, 8)
            If .Value <> "" And .Value <> "F" And .Value <> "N" Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Les caractères acceptés sont ""N"" ,""F"" et case vides "
                compte_false = compte_false + 1
            End If
        End With
        'Code article
        With .Cells(i, 9)
            If .Value = "" Then
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 6
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Pas de cellules vides autorisées"
                compte_miss = compte_miss + 1
            End If
        End With
        'Article
        With .Cells(i, 10)
            If .Value = "" Then
                .Font.ColorIndex = 3
                .Interior.ColorIndex = 6
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Pas de cellules vides autorisées"
                compte_miss = compte_miss + 1
            End If
        End With
        'Code EAN
        With .Cells(i, 13)
            If Len(.Value) <> 13 And .Value <> "" Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Le code EAN doit comporté 13 caractères"
                compte_false = compte_false + 1
            End If
        End With
        'Sig Pm
        With .Cells(i, 15)
            If Len(.Value) <> 3 And .Value <> "" Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Sig Pm doit comporté 3 caractères"
                compte_false = compte_false + 1
            End If
        End With
        'marché
        With .Cells(i, 38)
            If Len(.Value) > 1 Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="Seulement 1 caractère pour cette cellule"
                compte_false = compte_false + 1
            End If
        End With
        'Domaine
        With .Cells(i, 39)
            If Len(.Value) <> 0 And Len(.Value) <> 2 Then
                .Interior.Color = RGB(0, 0, 0)
                .Font.Color = RGB(255, 255, 255)
                .Font.Bold = True
                .AddComment
                .Comment.Text Text:="2 caractères pour cette cellule"
                compte_false = compte_false + 1
            End If
        End With
        If compte_false + compte_miss - Cpt > 0 Then
            k = k + 1
            Feuil6.Cells(k, 1).Value = i
            Cpt = compte_false + compte_miss
        End If
        Application.StatusBar = "Patientez: Traitement effectué à " & Int(100 * i / Nb_ligne) & " %"
    Next i
End With
If Feuil6.Cells(1, 1) <> "" Then misenforme
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub

Edit:
J'ai pris en compte compte_false et compte_miss
si tu veux seulement reporter les lignes avec compte_false, change comme ceci cette partie

Code:

1
2
3
4
5
        If compte_false - Cpt > 0 Then
            k = k + 1
            Feuil6.Cells(k, 1).Value = i
            Cpt = compte_false
        End If

08/02/2011, 12h53
Didier Gonard
Bonjour,

dodo69, Ok pour ta réponse, mais je préfère que la personne qui pose la question donne précisément ce qui va permettre au contributeur de l’aider plutôt que ce soit à celui-ci de se taper tout le déchiffrage d’un code pour trouver LE point précis.

Ton souci, n’est pas un problème de code en lui-même, mais de conception.

Parcourir une collection (ce que ton code revient à faire) est souvent la pire des solutions car très chronophage. Donc on cherche à éviter quand il commence à y avoir du monde et si on peut faire autrement.

Le but de mes questions était de voir les caractéristiques qui permettraient de sélectionner les cellules voulues via une instruction native d’Excel ce qui est toujours d’une rapidité incomparable.

Vu que tu as la chance d’être sous 2007, une des grosses évolutions est de pouvoir se servir des couleurs dans les filtres ! (en plus l'enregistreur de macros donne tous les mots clefs nécessaires).

Tu le fais couleur par couleur, colonnes par colonnes.
Tu récupères les données voulues via une utilisation de SpecialCells(xlCellTypeVisible).
Code:

1 2 ' retourne le nombre de lignes concernées sans les titres. MsgBox Worksheets(1).AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count – 1
Tu mets en variable tableau les N°s de ligne récupérés à chaque fois et tu exploites à ta convenance.

ou une astuce du genre, un timer chrono mettra en avant les différences.

cordialement,

Didier
08/02/2011, 13h56
dodo69

Merci à vous deux pour vos solutions

Je vais me baser sur celle de mercatog, plus simple d'utilisation même si les deux méthodes semblent très pertinentes

Cordialement
Dorian