Discussion :

[retraite83]

Bonjour,

je veux compter le nombre de cellule en fonction de leur couleur, j'ai réussi à le faire mais il y a un point que je n'arrive pas à expliquer dans ma macro :

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
 
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cpt, NbRouge As Integer
Dim coul As String
NbRouge = -1
    If Not Application.Intersect(Target, Range("C6:AF11")) Is Nothing Then
        coul = Target.Interior.Color
        Cancel = True
        Select Case coul
        Case RGB(255, 255, 255): Target.Interior.Color = RGB(255, 0, 0)       ' après blanc --> rouge
        Case RGB(255, 0, 0): Target.Interior.Color = RGB(51, 51, 255)         ' après rouge --> bleu
        Case RGB(51, 51, 255): Target.Interior.Color = RGB(51, 204, 51)       ' après bleu  -> vert
        Case RGB(51, 204, 51): Target.Interior.Color = RGB(255, 255, 255)     ' après vert boucle sur blanc
        End Select
    End If
 
    For Each Target In Range("C6:AF11")
     If Target.Interior.Color = RGB(255, 0, 0) Then
     NbRouge = NbRouge + 1
     Range("AH6").Value = NbRouge
     End If
    Next
End Sub

Ma question : pour que le résultat soit bon pourquoi ai-je été obligé de mettre :

Code :

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

1
2
 
NbRouge = -1

[jerome.vaussenat]

Salut,

Effectivement, c'est d'autant plus bizarre que pour moi, il doit être à 0.

Je suis sur Excel 365...

[retraite83]

Je suis sur Excel 2016 (mais pas avec office 365, excel seul)

en fait le compteur s'incrémente et se décrémente bien en jouant sur la couleur des cellules le problème bizarre c'est qu'en revenant en arrière le compteur ne revient jamais à 0 mais reste à 1 lorsqu'il n'y a plus de cellule rouge...

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
 
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cpt, NbRouge As Integer
Dim coul As String
NbRouge = 0
 
    If Not Application.Intersect(Target, Range("C6:AG11")) Is Nothing Then
        coul = Target.Interior.Color
        Cancel = True
        Select Case coul
        Case RGB(255, 255, 255): Target.Interior.Color = RGB(255, 0, 0)       ' après blanc --> rouge
        Case RGB(255, 0, 0): Target.Interior.Color = RGB(51, 51, 255)         ' après rouge --> bleu
        Case RGB(51, 51, 255): Target.Interior.Color = RGB(51, 204, 51)       ' après bleu  -> vert
        Case RGB(51, 204, 51): Target.Interior.Color = RGB(255, 255, 255)     ' après vert boucle sur blanc
        End Select
    End If
 
    For Each Target In Range("C6:AG6")
     If Target.Interior.Color = RGB(255, 0, 0) Then
     NbRouge = NbRouge + 1
     Range("AH6").Value = NbRouge
     End If
    Next
 
End Sub

[MarcClap]

Bonjour à tous,
Il faut déplacer la valorisation de la cellule AH6 pour que son exécution ne soit pas conditionnée par la découverte d'une case rouge.

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
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim cpt, NbRouge As Integer
    Dim coul As String
    
    'NbRouge = -1
    If Not Application.Intersect(Target, Range("C6:AF11")) Is Nothing Then
        coul = Target.Interior.Color
        Cancel = True
        Select Case coul
        Case RGB(255, 255, 255): Target.Interior.Color = RGB(255, 0, 0)       ' après blanc --> rouge
        Case RGB(255, 0, 0): Target.Interior.Color = RGB(51, 51, 255)         ' après rouge --> bleu
        Case RGB(51, 51, 255): Target.Interior.Color = RGB(51, 204, 51)       ' après bleu  -> vert
        Case RGB(51, 204, 51): Target.Interior.Color = RGB(255, 255, 255)     ' après vert boucle sur blanc
        End Select
    End If
     
    For Each Target In Range("C6:AF11")
        If Target.Interior.Color = RGB(255, 0, 0) Then
            NbRouge = NbRouge + 1
        End If
    Next
    Range("AH6").Value = NbRouge
    
End Sub

[retraite83]

OUI tout à fait, merci !

[patricktoulon]

le compte est bon