Discussion :

[Saint_Leu]

Bonjour,

J'essaie de me crée un compteur de couleur. J'aimerai les résultats sur une feuille et la recherche sur une autre. Je bloque bêtement. Je pense que c'est mes déclarations qui sont pas complète.

[BENNASR]

bonjour
pour éviter le risque de dysfonctionnement, il est recommandé à mon modeste avis de déclarer les onglets
à tester :

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
Option Explicit
 
Sub Comptage_des_lignes()
 
Dim F1 As Worksheet
Dim F2 As Worksheet
'Definition des variables
Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
'Defninir les lignes du tableau
Dim NbrLigne As Long, i As Long
NbrLigne = F2.Range("A" & Rows.Count).End(xlUp).Row
'Trouver couleur des cellules recherchees
Dim CouleurPercu As Long, CouleurPreparee As Long, CouleurTraitee As Long, CouleurAnnulee As Long
 
'Compteur des couleurs trouvées
Dim NbrPercu As Long, NbrPreparee As Long, NbrTraitee As Long, NbrAnnulee As Long
 
 
 
'Initialisation des variables couleurs
CouleurPercu = F1.Range("D1").Offset(0, -1).Interior.Color
CouleurPreparee = F1.Range("D2").Offset(0, -1).Interior.Color
CouleurTraitee = F1.Range("D3").Offset(0, -1).Interior.Color
CouleurAnnulee = F1.Range("D4").Offset(0, -1).Interior.Color
 
 
 
''initialisation des compteurs, non obligatoir car excel par de zero
'NbrPercu = 0
'NbrPreparee = 0
'NbrTraitee = 0
'NbrAnnulee = 0
 
For i = 2 To NbrLigne
If F2.Range("A" & i).Interior.Color = CouleurPercu Then NbrPercu = NbrPercu + 1
If F2.Range("A" & i).Interior.Color = CouleurPreparee Then NbrPreparee = NbrPreparee + 1
If F2.Range("A" & i).Interior.Color = CouleurTraitee Then NbrTraitee = NbrTraitee + 1
If F2.Range("A" & i).Interior.Color = CouleurAnnulee Then NbrAnnulee = NbrAnnulee + 1
Next i
 
'collage du resultat
F1.Range("D1").Value = NbrPercu
F1.Range("D2").Value = NbrPreparee
F1.Range("D3").Value = NbrTraitee
F1.Range("D4").Value = NbrAnnulee
 
End Sub

[Saint_Leu]

Bonjour,

Je réponds tardivement. Ca a l'air propre. je test demain.

Merci

[Saint_Leu]

Alors la, j'ai un souci.

Votre code marche parfaitement. Mais quand j’adapte a mon tableau, plus rien ne va.

[BENNASR]

Bonjour
j'ai ajouter deux petites choses :
1- Mettre zéro en D1/D2/D3/D4 pour annuler l'ancien calcul
2- Fin du macro j'ai mettre zéro pour les 4 variables

tester :

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
Option Explicit
 
 
Sub Comptage_des_lignes()
 
Dim MAGASIN As Worksheet
Dim Indicateurs As Worksheet
'Definition des variables
Set MAGASIN = Sheets("MAGASIN")
Set Indicateurs = Sheets("Indicateurs")
'Defninir les lignes du tableau
Dim NbrLigne As Long, i As Long
NbrLigne = MAGASIN.Range("A" & Rows.Count).End(xlUp).Row
'Trouver couleur des cellules recherchees
Dim CouleurPercu As Long, CouleurPreparee As Long, CouleurTraitee As Long, CouleurAnnulee As Long
 
'Compteur des couleurs trouvées
Dim NbrPercu As Long, NbrPreparee As Long, NbrTraitee As Long, NbrAnnulee As Long
 
 Application.ScreenUpdating = False
 
' vider l'ancien calcul
 
Indicateurs.Range("D1") = 0
Indicateurs.Range("D2") = 0
Indicateurs.Range("D3") = 0
Indicateurs.Range("D4") = 0
 
 
'Initialisation des variables couleurs
CouleurPercu = Indicateurs.Range("D1").Offset(0, -1).Interior.Color
CouleurPreparee = Indicateurs.Range("D2").Offset(0, -1).Interior.Color
CouleurTraitee = Indicateurs.Range("D3").Offset(0, -1).Interior.Color
CouleurAnnulee = Indicateurs.Range("D4").Offset(0, -1).Interior.Color
 
 
 
''initialisation des compteurs, non obligatoir car excel par de zero
'NbrPercu = 0
'NbrPreparee = 0
'NbrTraitee = 0
'NbrAnnulee = 0
 
For i = 2 To NbrLigne
If MAGASIN.Range("A" & i).Interior.Color = CouleurPercu Then NbrPercu = NbrPercu + 1
If MAGASIN.Range("A" & i).Interior.Color = CouleurPreparee Then NbrPreparee = NbrPreparee + 1
If MAGASIN.Range("A" & i).Interior.Color = CouleurTraitee Then NbrTraitee = NbrTraitee + 1
If MAGASIN.Range("A" & i).Interior.Color = CouleurAnnulee Then NbrAnnulee = NbrAnnulee + 1
Next i
 
'collage du resultat
Indicateurs.Range("D1").Value = NbrPercu
Indicateurs.Range("D2").Value = NbrPreparee
Indicateurs.Range("D3").Value = NbrTraitee
Indicateurs.Range("D4").Value = NbrAnnulee
 
 NbrPercu = 0
 NbrPreparee = 0
 NbrTraitee = 0
 NbrAnnulee = 0
 
 Application.ScreenUpdating = True
End Sub

[Saint_Leu]

Ca fonctionne parfaitement.

Merci