compte couleur

rudy dehaudt

XLDnaute Occasionnel
bonjour à tous,
je n arrive pas à adapter le code suivant ?
qui compte le nombre de case de couleur rouge à partir de a3:a et donne le resultat en a1.
pourriez vous jeter un coup d'oeil ?
part avance merci

A+



sub comptercouleurs ()
Dim CompterCellules As Integer
Dim Cellules As Range

'compter rouge
Sheets("feuil1").Select
Range("A:A").select

For Each Cellules In Selection

If Cellules.Interior.ColorIndex = 38 Then 'n°3 = rouge
CompterCellules = CompterCellules + 1
End If
Next Cellules
Sheets("feuil2").Activate
[c2] = CompterCellules

End sub
 

Pièces jointes

  • compte couleur.xls
    16.5 KB · Affichages: 35
  • compte couleur.xls
    16.5 KB · Affichages: 36
  • compte couleur.xls
    16.5 KB · Affichages: 37

Grand Chaman Excel

XLDnaute Impliqué
Re : compte couleur

Bonjour,

Voici une version de ton code modifié. Note que la couleur rouge est 3 et non pas 38...
Note aussi qu'au lieu de vérifier toutes les cellules de la colonne A, tu pourrais limiter la plage en allant chercher la dernière ligne de la colonne A. De cette façon, ton code serait plus rapide...

Code:
Sub comptercouleurs()
Dim CompterCellules As Integer
Dim Cellules As Range

'compter rouge
For Each Cellules In Sheets("Feuil1").Range("A:A")
    If Cellules.Interior.ColorIndex = 3 Then CompterCellules = CompterCellules + 1
Next Cellules
Sheets("feuil2").Range("c2") = CompterCellules

End Sub

A+

Edit : voici le code pour limiter la plage :

Code:
Sub comptercouleurs()
Dim CompterCellules As Integer
Dim Cellules As Range

'compter rouge
For Each Cellules In Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A65000").End(xlUp).Row)
    If Cellules.Interior.ColorIndex = 3 Then CompterCellules = CompterCellules + 1
Next Cellules
Sheets("feuil2").Range("c2") = CompterCellules

End Sub
 

rudy dehaudt

XLDnaute Occasionnel
Re : compte couleur

bonjour grand chaman excel,
j ai modifier le ton code pour qu il affiche le resultat en A1 de la feuil3 mais excels affiche l indice n appartiens pas a la selection ?

Sub comptercouleurs()
Dim CompterCellules As Integer
Dim Cellules As Range

'compter rouge
For Each Cellules In Sheets("Feuil3").Range("A3:A200")
If Cellules.Interior.ColorIndex = 3 Then CompterCellules = CompterCellules + 1
Next Cellules
Sheets("feuil3").Range("A1") = CompterCellules

End Sub

peux tu voire le souci

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 429
Messages
2 088 351
Membres
103 823
dernier inscrit
ben talha redouane