Ranger par couleur

Bonjour ,

Je cherche à comptabiliser les cellules d'un tableau qui sont en jaune , sachant que cela peut bouger sur toutes les colonnes .

J'ai essayé avec

Sub NbColor()

Dim Tnb(2, 0) As Integer, clr, c As Range, i%

clr = Array(vbYellow, RGB(255, 192, 0), vbRed)

With ActiveSheet

For Each c In .Range("A3:P26")

For i = 0 To 2

If c.DisplayFormat.Interior.Color = clr(i) Then

Tnb(i, 0) = Tnb(i, 0) + 1: Exit For

End If

Next i

Next c

.Range("K6:K8").Value = Tnb

End With

End Sub

Mais cela ne marche pas .... Je joins le fichier Merci de m'aiguiller ...

7cantine-test.xlsx (16.99 Ko)

Bonjour

Pour faire les tests, j'ai fait quelques "adaptations"

Je ne suis pas certain, mais il me semble que la fonction resize (en fin de procédure) n'accepte pas le 0 ce qui est logique, puisqu'elle travaille sur une cellule !

C'est donc pour cela que j'ai modifié ton initialisation de tableau (au début)

Sub NbColor()
Dim Tnb(3, 0) As Integer, clr, c As Range, i%
    clr = Array(vbYellow, vbGreen, vbRed)
    With ActiveSheet
        For Each c In .Range("A3:P26")
            For i = 0 To 2
                If c.Interior.Color = clr(i) Then
                    Tnb(i, 0) = Tnb(i, 0) + 1
                    Exit For
                End If
            Next i
        Next c
        '.Range("K6:K8").Value = Tnb
    End With
    Cells(3, 9).Resize(UBound(Tnb, 1), 1) = Tnb
End Sub

Je vais le tenter , merci . Je te tiens au jus .

C'est bon , j'ai trouvé grâce à ton aide . Merci

Bonjour

fildefer66 a écrit :

C'est bon , j'ai trouvé grâce à ton aide . Merci

Parfait et merci à toi !
Rechercher des sujets similaires à "ranger couleur"