Compter des cellules en couleur (formatage conditionel)

**dede_bo** · 05/07/2016, 11h29

Bonjour,

Je me casse la tête à essayer de compter les cellules rouge.
Elle sont le résultat d'un affichage conditionnel.
si certaines cellules sont vides, c'est rouge autrement rien.

Mon tableau : En cellule B3, j'ai une valeur (nom d'un pays)
en cellule D3, j'ai une valeur (quelconque)
les autres cellules (A3, C3 et E3) possèdent également des valeurs. Pas important ici.

Les cellules B3 et D3 doivent avoir une valeur autrement je dois mettre les cellules en rouge.
J'ai crée une règle de formatage qui dit simplement de mettre le fond en rouge si c'est vide.

Au moment de sauver ou de fermer le document, je dois avertir qu'il y a des cellules en rouge (donc je dois compter les cellules rouge).
Je ne peux pas utiliser de "CountIF" du fait des couleurs conditionnel.

J'ai regardé sur ce forum (et d'autres) et en autre cette discussion : http://www.developpez.net/forums/d14...e-couleur-mfc/

aussi ce lien : http://www.cpearson.com/excel/cfcolors.htm

Ici, la fonction "ActiveCondition" ne possède pas la clause quand le contenu est vide. Donc, j'ai ajouté un "case xlBlanksCondition" qui retourne la valeur "1".
Je ne comprends pas sa fonction "GetStrippedValue" je ne vois pas ce qu'elle extrait.
Car, quand je l'applique à mon cas, je reçois un contenu complètement absurde.

Code :

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

 colindex = ColorIndexOfCF(range("D5"))

Quand j’exécute la fonction ColorIndexOfCF en pas à pas, il m'extrait la formule " =LEN(TRIM(B3))=0 " et non D5 !...

Rien à faire, Excel à décidé de m'embêter (pour rester poli).

Dans mon tableau, mon formatage conditionnel est une plage de donnée pas une cellule. Et donc, lorsque je capte la formule, elle pointe vers une autre cellule.
Et donc, je ne sais pas quoi faire !

Toute aide, astuce ou autre sont les bienvenus.

Merci de votre aide.
Bonne journée
André

**Slooby** · 05/07/2016, 11h58

Bonjour,

Je ne suis pas sûr d'avoir tout compris.

Ce que tu veux est:
- parcourir toutes les cellules d'une colonne / d'une plage
- compter celles qui ont le fond en rouge

C'est ça ?

Quand tu dis rouge, c'est le même rouge que VBA ( = vbRed ) ou c'est un rouge spécial mais que toi tu vois rouge ? (ex: RGB(255,10,10)) ?

Slooby

**Menhir** · 05/07/2016, 12h48

Envoyé par dede_bo

Je me casse la tête à essayer de compter les cellules rouge.
Elle sont le résultat d'un affichage conditionnel.
si certaines cellules sont vides, c'est rouge autrement rien.

Sujet maintes fois traité avec toujours la même conclusion : Il est quasiment impossible en VBA de tester le résultat d'une MFC, mieux vaut tester les conditions que contient la MFC.

Dans ton cas, mieux vaut compter les cellules vides.
Tu peux faire une boucle For to et vérifier les vides avec un test Cellule = "".

Plus rapide, il y a SpecialCells.
Par exemple, si tu veux connaitre le nombre de cellules vides en B3:B100 :

Code :

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

Range("B3:B100").SpecialCells(xlCellTypeBlanks).Count

**dede_bo** · 05/07/2016, 13h17

Bonjour
Je n'y ai pas pensé. Merci à Menhir pour son astuce.

Juste un point, cette fonction n'est utile que si vous avez moins de 8192 cellules selectionnées !
(C'est Microsoft qui le dit).

Lien Microsoft: https://support.microsoft.com/fr-fr/kb/832293

Pour éviter ce désagrément, simplement faire une boucle et sélectionner ligne par ligne

Merci à tous

André

**Menhir** · 05/07/2016, 13h27

Envoyé par dede_bo

Pour éviter ce désagrément, simplement faire une boucle et sélectionner ligne par ligne

C'est pourquoi j'ai préconiser en premier la solution avec une boucle.

**nacereddine.mourad** · 05/07/2016, 16h07

Bonjour à tous, il y’a une autre solution, ce module contient plusieurs fonction comme =nb_font

à copier dans un module

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
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
Option Explicit
Function nb_color(plage As Range, couleur As Integer) As Long
    Dim gw_cel As Range, nb As Long
    Application.Volatile
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur Then nb = nb + 1
    Next
    nb_color = nb
End Function
Function sum_color(plage As Range, couleur As Integer) As Double
    Dim gw_cel As Range, nb As Double
    Application.Volatile
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur Then nb = nb + gw_cel.Value
    Next
    sum_color = nb
End Function
 
Function moy_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_color = montant / nb
End Function
 
Function mini_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
        End If
    Next
    mini_color = montant
End Function
Function maxi_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex = couleur Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
        End If
    Next
    maxi_color = montant
End Function
Function nb_font_color(plage As Range, couleur As Integer) As Long
    Application.Volatile
    Dim gw_cel As Range, nb As Long
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.ColorIndex = couleur Then nb = nb + 1
    Next
    nb_font_color = nb
End Function
Function sum_font_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Double
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.ColorIndex = couleur Then nb = nb + gw_cel.Value
    Next
    sum_font_color = nb
End Function
 
Function moy_font_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.ColorIndex = couleur Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_font_color = montant / nb
End Function
 
Function mini_font_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.ColorIndex = couleur Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
    Next
    mini_font_color = montant
End Function
Function maxi_font_color(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.ColorIndex = couleur Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
    Next
    maxi_font_color = montant
End Function
Function nb_font_bold(plage As Range, valeur As Boolean) As Long
    Application.Volatile
    Dim gw_cel As Range, nb As Long
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Bold = valeur Then nb = nb + 1
    Next
    nb_font_bold = nb
End Function
Function sum_font_bold(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Double
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Bold = valeur Then nb = nb + gw_cel.Value
    Next
    sum_font_bold = nb
End Function
 
Function moy_font_bold(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Bold = valeur Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_font_bold = montant / nb
End Function
 
Function mini_font_bold(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Bold = valeur Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
    Next
    mini_font_bold = montant
End Function
Function maxi_font_bold(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Bold = valeur Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
    Next
    maxi_font_bold = montant
End Function
Function nb_font_italic(plage As Range, valeur As Boolean) As Long
    Application.Volatile
    Dim gw_cel As Range, nb As Long
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Italic = valeur Then nb = nb + 1
    Next
    nb_font_italic = nb
End Function
Function sum_font_italic(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Double
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Italic = valeur Then nb = nb + gw_cel.Value
    Next
    sum_font_italic = nb
End Function
 
Function moy_font_italic(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Italic = valeur Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_font_italic = montant / nb
End Function
 
Function mini_font_italic(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Italic = valeur Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
    Next
    mini_font_italic = montant
End Function
Function maxi_font_italic(plage As Range, valeur As Boolean) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Italic = valeur Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
    Next
    maxi_font_italic = montant
End Function
 
Function nb_font_underline(plage As Range, couleur As Integer) As Long
    Application.Volatile
    Dim gw_cel As Range, nb As Long
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Underline = couleur Then nb = nb + 1
    Next
    nb_font_underline = nb
End Function
Function sum_font_underline(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Double
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Font.Underline = couleur Then nb = nb + gw_cel.Value
    Next
    sum_font_underline = nb
End Function
 
Function moy_font_underline(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Underline = couleur Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_font_underline = montant / nb
End Function
 
Function mini_font_underline(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Underline = couleur Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
    Next
    mini_font_underline = montant
End Function
Function maxi_font_underline(plage As Range, couleur As Integer) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Font.Underline = couleur Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
    Next
    maxi_font_underline = montant
End Function
 
Function nb_font(plage As Range, cellule As Range) As Long
    Application.Volatile
    Dim gw_cel As Range, nb As Long, res(5) As Integer, i As Integer
    nb = 0
    For Each gw_cel In plage
        For i = 0 To 5: res(i) = 0: Next i
        If gw_cel.Interior.ColorIndex = cellule.Interior.ColorIndex Then res(1) = 1
        If gw_cel.Font.ColorIndex = cellule.Font.ColorIndex Then res(2) = 1
        If gw_cel.Font.Bold = cellule.Font.Bold Then res(3) = 1
        If gw_cel.Font.Italic = cellule.Font.Italic Then res(4) = 1
        If gw_cel.Font.Underline = cellule.Font.Underline Then res(5) = 1
        For i = 1 To 5: res(0) = res(0) + res(i): Next i
        If res(0) = 5 Then nb = nb + 1
    Next
    nb_font = nb
End Function
 
Function sum_font(plage As Range, cellule As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, montant  As Double, nb As Long, res(5) As Integer, i As Integer
    montant = 0#: nb = 0
    For Each gw_cel In plage
        For i = 0 To 5: res(i) = 0: Next i
        If gw_cel.Interior.ColorIndex = cellule.Interior.ColorIndex Then res(1) = 1
        If gw_cel.Font.ColorIndex = cellule.Font.ColorIndex Then res(2) = 1
        If gw_cel.Font.Bold = cellule.Font.Bold Then res(3) = 1
        If gw_cel.Font.Italic = cellule.Font.Underline Then res(4) = 1
        If gw_cel.Font.Underline = cellule.Font.Underline Then res(5) = 1
        For i = 1 To 5: res(0) = res(0) + res(i): Next i
        If res(0) = 5 Then montant = montant + gw_cel.Value
    Next
    sum_font = montant
End Function
 
Function moy_font(plage As Range, cellule As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, montant  As Double, nb As Long, res(5) As Integer, i As Integer
    montant = 0#: nb = 0
    For Each gw_cel In plage
        For i = 0 To 5: res(i) = 0: Next i
        If gw_cel.Interior.ColorIndex = cellule.Interior.ColorIndex Then res(1) = 1
        If gw_cel.Font.ColorIndex = cellule.Font.ColorIndex Then res(2) = 1
        If gw_cel.Font.Bold = cellule.Font.Bold Then res(3) = 1
        If gw_cel.Font.Italic = cellule.Font.Underline Then res(4) = 1
        If gw_cel.Font.Underline = cellule.Font.Underline Then res(5) = 1
        For i = 1 To 5: res(0) = res(0) + res(i): Next i
        If res(0) = 5 Then montant = montant + gw_cel.Value: nb = nb + 1
    Next
    If nb > 0 Then moy_font = montant / nb
End Function
 
Function mini_font(plage As Range, cellule As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, montant  As Double, nb As Long, res(5) As Integer, i As Integer
    montant = 0#: nb = 0
    For Each gw_cel In plage
        For i = 0 To 5: res(i) = 0: Next i
        If gw_cel.Interior.ColorIndex = cellule.Interior.ColorIndex Then res(1) = 1
        If gw_cel.Font.ColorIndex = cellule.Font.ColorIndex Then res(2) = 1
        If gw_cel.Font.Bold = cellule.Font.Bold Then res(3) = 1
        If gw_cel.Font.Italic = cellule.Font.Underline Then res(4) = 1
        If gw_cel.Font.Underline = cellule.Font.Underline Then res(5) = 1
        For i = 1 To 5: res(0) = res(0) + res(i): Next i
        If res(0) = 5 Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
        End If
    Next
    mini_font = montant
End Function
Function maxi_font(plage As Range, cellule As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, montant  As Double, nb As Long, res(5) As Integer, i As Integer
    montant = 0#: nb = 0
    For Each gw_cel In plage
        For i = 0 To 5: res(i) = 0: Next i
        If gw_cel.Interior.ColorIndex = cellule.Interior.ColorIndex Then res(1) = 1
        If gw_cel.Font.ColorIndex = cellule.Font.ColorIndex Then res(2) = 1
        If gw_cel.Font.Bold = cellule.Font.Bold Then res(3) = 1
        If gw_cel.Font.Italic = cellule.Font.Underline Then res(4) = 1
        If gw_cel.Font.Underline = cellule.Font.Underline Then res(5) = 1
        For i = 1 To 5: res(0) = res(0) + res(i): Next i
        If res(0) = 5 Then If montant < gw_cel.Value Then montant = gw_cel.Value
    Next
    maxi_font = montant
End Function
Function nb_inter(plage As Range) As Long
    Dim gw_cel As Range, nb As Long
    Application.Volatile
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex <> xlNone Then nb = nb + 1
    Next
    nb_inter = nb
End Function
Function sum_inter(plage As Range) As Double
    Dim gw_cel As Range, nb As Double
    Application.Volatile
    nb = 0
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex <> xlNone Then nb = nb + gw_cel.Value
    Next
    sum_inter = nb
End Function
 
Function moy_inter(plage As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    nb = 0: montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex <> xlNone Then nb = nb + 1: montant = montant + gw_cel.Value
    Next
    If nb > 0 Then moy_inter = montant / nb
End Function
 
Function mini_inter(plage As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex <> xlNone Then
            If montant = 0 Then montant = gw_cel.Value
            If montant > gw_cel.Value Then montant = gw_cel.Value
        End If
    Next
    mini_inter = montant
End Function
Function maxi_inter(plage As Range) As Double
    Application.Volatile
    Dim gw_cel As Range, nb As Long, montant As Double
    montant = 0#
    For Each gw_cel In plage
        If gw_cel.Interior.ColorIndex <> xlNone Then
            If montant < gw_cel.Value Then montant = gw_cel.Value
        End If
    Next
    maxi_inter = montant
End Function

bonne continuation

**Marc-L** · 05/07/2016, 16h15

Bonjour, bonjour,

réalisable en une seule ligne de code via la fonction de feuille de calculs NB.VIDE ‼

Voilà, voilà !

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

**Menhir** · 05/07/2016, 16h30

Envoyé par nacereddine.mourad

Bonjour à tous, il y’a une autre solution, ce module contient plusieurs fonction comme =nb_font

Ces fonctions ne marcheront pas si la couleur provient d'une mise en forme conditionnelle.

Compter des cellules en couleur (formatage conditionel)

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager