XL 2016 Compter des Cellules de couleur avec une condition

QEspinaco

XLDnaute Nouveau
Bonjour, je voudrais faire un comptage de cellules de couleur qui contienne des valeurs.
Par exemple si j'ai 8 cellules rouges noté 1,1,2,2,2,3,3,1 et 3 cellules vertes noté 1,2,2 je voudrais que la fonction me sorte 3 pour le nombre de 1 rouge et 2 pour le nombre de 2 verts.

J'ai réussi à coder une fonction qui me donne le nombre de cellules d'une même couleur mais j'aurais besoin d'être plus précis.

En entrée de la fonction j'aimerais mettre : la plage de données à traiter, la couleur et le nombre à compter pour pouvoir faire pareil pour chaque nombre de chaque couleur.

Si quelqu'un aurait une idée ? Je ne sais pas très bien coder sur Excel...

Voici déjà la fonction pour compter les cellules d'une même couleur :

VB:
Function CountCcolor(range_data As Range, criteria As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
    If datax.Interior.ColorIndex = xcolor Then
        CountCcolor = CountCcolor + 1
    End If
Next datax

End Function

••••ˇˇˇˇ
 

Pièces jointes

  • Test Comptage Couleur.xlsm
    15.4 KB · Affichages: 1
Dernière édition:
Solution
Bonjour,
Peut être comme ça.
Le dernier paramètre de la fonction correspond au nombre 1,2,3 ....
VB:
Function CountCouleur2(range_data As Range, criteria As Range, xNbr As Integer) As Long
    Dim datax As Range
    Dim xcolor As Long
    xcolor = criteria.Interior.ColorIndex
    For Each datax In range_data
        If datax.Interior.ColorIndex = xcolor Then
            If datax.Value = xNbr Then
                 xcpt = xcpt + 1
            End If
        End If
    Next datax
    CountCouleur2 = xcpt
End Function
@+ Lolote83

Lolote83

XLDnaute Accro
Bonjour,
Peut être comme ça.
Le dernier paramètre de la fonction correspond au nombre 1,2,3 ....
VB:
Function CountCouleur2(range_data As Range, criteria As Range, xNbr As Integer) As Long
    Dim datax As Range
    Dim xcolor As Long
    xcolor = criteria.Interior.ColorIndex
    For Each datax In range_data
        If datax.Interior.ColorIndex = xcolor Then
            If datax.Value = xNbr Then
                 xcpt = xcpt + 1
            End If
        End If
    Next datax
    CountCouleur2 = xcpt
End Function
@+ Lolote83
 

Discussions similaires

Haut Bas