XL 2016 Nombre de couleur

[Tsimbina]

Bonjour,

Quelqu'un connait une formule pour déterminer le nombre de couleur dans un tableau excel ?
En PJ un fichier exemple.

Merci d'avance.

 

[Quincy]

Bonjour Tsimbina, le forum.

Avec une fonction.

Function CompteCouleur(plage As Range, CouleurReference As Range) As Integer
Application.Volatile
Dim r As Range
Dim i As Integer
For Each r In plage
If r.Interior.Color = CouleurReference.Interior.Color Then i = i + 1
Next
CompteCouleur = i
End Function

 

[Phil69970]

Bonjour @Tsimbina , @Quincy

Je te propose ce fichier

*Merci de ton retour

@Phil69970

 

[Tsimbina]

Bonjour Tsimbina, le forum.

Avec une fonction.

Function CompteCouleur(plage As Range, CouleurReference As Range) As Integer
Application.Volatile
Dim r As Range
Dim i As Integer
For Each r In plage
If r.Interior.Color = CouleurReference.Interior.Color Then i = i + 1
Next
CompteCouleur = i
End Function

Merci pour votre retour.

 

[Tsimbina]

Bonjour @Tsimbina , @Quincy

Je te propose ce fichier

*Merci de ton retour

@Phil69970

Merci de ton retour

 

[Tsimbina]

Problème résolu!

 

[Eric C]

Bonjour le forum
Bonjour Tsimbina, Quincy et Philippe

@Philippe : 😉 Je me permets d'ajouter une ligne de code car si le User désire changer une couleur et appuie de nouveau sur le Bouton, les valeurs déjà présentes s'additionnent (ou même s'il appuie une 2ème fois sur le Bouton).

Option Explicit
Sub Nb_Coul()
Dim CouleurRef As Variant
Dim PlageLigneCouleur As Range, Cel As Range
Dim NbLigneCouleur&, i&, j&, k&

 ActiveSheet.UsedRange.Rows("4:" & ActiveSheet.UsedRange.Rows.Count) = ""


 Set PlageLigneCouleur = Range("A3:A" & Rows.Count).SpecialCells(xlCellTypeBlanks)
For Each Cel In PlageLigneCouleur
    If Cel.Interior.Color <> 16777215 Then NbLigneCouleur = Cel.Row
Next
For k = 4 To NbLigneCouleur
    For j = 7 To 10 'Les colonnes G à J
        CouleurRef = Cells(3, j).Interior.Color
        For i = 1 To 6 'La couleur à tester
            If CouleurRef = Cells(k, i).Interior.Color Then 'La couleur match alors on la compte
                Cells(k, j).Value = Cells(k, j).Value + 1
            End If
        Next i
    Next j
Next k
End Sub

Sub CommandButton1_Click()
Nb_Coul
End Sub

Bonne après-midi à toutes & àtous
@+ Eric c

 

[Phil69970]

Bonjour le fil

@Eric C

Tu as raison je me suis tâté pour savoir si je réinitialisais la feuille à chaque fois ou si l'utilisateur effaçait à la mimine la feuille

J'ai même fait une version ou on peut rajouter x colonnes .....
La voici avec ta RAZ de la feuille... 😉

Cela pourrait intéressé quelqu'un....

@Phil69970

 

[mapomme]

Bonsoir à tous,

Il faut rappeler au demandeur qu'un changement de couleur (au moyen de la palette - couleur remplissage) ne déclenche aucun évènement de re-calcul de fonction (que la fonction comporte ou non l'instruction Application.Volatile)
Il faut donc "être prudent"...

 

[Tsimbina]

Bonsoir à tous,

Merci pour tous!!!!!