Countccolor sous condition

Bonjour,

J'utilise CountcColor dans le fichier ci-joint : calcul du nbre de cellule d'une certaine couleur dans une colonne regroupant des dates.

Je voudrais rajouter une condition : l'année (cellule A9) et donc limiter le nbre de cellule de telle ou telle couleur en fonction de l'année des dates inscrites dans la colonne A

Mon gourou personnel ne trouvant pas de solution, je me tourne vers vous en espérant qu'une bonne âme pourra m'aider.

Merci d'avance

Salut,

essaye ça

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 r In range_data
    lg = r.Row
    If r.Interior.ColorIndex = xcolor Then
        If Year(Cells(lg, 1)) = Year(Cells(9, 1)) Then
            CountCcolor = CountCcolor + 1
        End If
    End If
Next r
End Function

si j'ai bien compris ce que tu voulais.

Bonjour,

ajoute l'année à ta fonction

Function CountCcolor(range_data As Range, criteria As Range, an As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
    xcolor = criteria.Interior.ColorIndex
    On Error Resume Next
    For Each datax In range_data
        If datax.Interior.ColorIndex = xcolor And Year(Cells(datax.Row, 1)) = an Then CountCcolor = CountCcolor + 1
    Next datax
End Function

ta formule devient alors

=CountCcolor(I$11:I$1830;$A$1;$R$1)

en mettant l'année en R1 par exemple

Bonjour Game Over, désolé je n'avais pas vu ton post !

Salut

une contribution :

=CountCcolor(B$11:B$1830;$A$3;$P$14) en mettant l'année en cellule P14 par exemple

ou encore :

=CountCcolor(B$11:B$1830;$A$3;"01/01/16") en mettant l'année entre " - -/- -/- -" par exemple

remplacer cette fonction par l ancienne :

Function CountCcolor(range_data As Range, criteria As Range, Optional Ldates As Date) As Long
Dim cntr As Integer
cntr = 0
    Dim datax As Range
    Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex

For Each datax In range_data ' And cndt = True
    If datax.Interior.ColorIndex = xcolor And Cells(datax.Row, 1) = Ldates Then
        cntr = cntr + 1
    End If
Next datax
 CountCcolor = cntr

End Function

Le fait que tu cache le zéro ca ma oblige de

@ AMIR

Curieux ! Cells(datax.Row, 1) ne contient pas l'année mais une date ...

Salut Steelson

Merci beaucoup pour la note, ca devrait fonctionne n'est ce pas ?:

Function CountCcolor(range_data As Range, criteria As Range, Optional Lyr As Range) As Long  '
Dim cntr As Integer
cntr = 0
    Dim datax As Range
    Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex

For Each datax In range_data ' And cndt = True
    If datax.Interior.ColorIndex = xcolor And Format(Cells(datax.Row, 1), "yyyy") = Format(Lyr, "yyyy") Then
        cntr = cntr + 1
    End If
Next datax
 CountCcolor = cntr
End Function

@Raimana

Il n'est pas facile d'ajouter un paramètre à une fonction existante ... je t'ai donc fait la modif dans ton fichier

Correction en ajoutant

application.volatile

Mais ce n'est pas possible, vous n'êtes pas "passionné" vous êtes complètement "givrés" ! Moi qui pensais que cela n'intéresserait personne, j'ai une solution en moins de 24 h !

Merci beaucoup.

Merci pour ton retour, et pour tous les contributeurs qui y ont participé.

Oui nous sommes givrés.

C'est toujours comme cela quand le sujet est bien décrit avec un fichier.

Pour info, deux solutions possibles :

Deux solutions :

- l'une associant formule et macro:

"=CountCcolor(INDIRECT(ADRESSE(13;COLONNE();2)):INDIRECT(ADRESSE(EQUIV(DATE(ANNEE($A$9);12;31);$A$1:$A$1840;0);COLONNE();2));$A1)"

- l'autre uniquement macro :

Function CountCcolor(range_data As Range, criteria As Range, an As Range) As Long

Application.Volatile

Dim datax As Range

Dim xcolor As Long

xcolor = criteria.Interior.ColorIndex

On Error Resume Next

For Each datax In range_data

If datax.Interior.ColorIndex = xcolor And Year(Cells(datax.Row, 1)) = an Then CountCcolor = CountCcolor + 1

Next datax

End Function

Apparemment pas de grosse différence de poids du fichier avec l'une ou l'autre solution ni de vitesse de mis à jour de données

Merci encore à tous

Raimana

Bonjour,

Petit constat : le tri des cellules en fonction de la couleur de fond demande beaucoup de temps que ce tri se fasse par macro ou par formules.

Si vous avez une solution qui me permettrait de bouster la vitesse de calcul et m'éviterait de tout changer, cela m'arrangerait.

A noter : le fichier pèse 1 500 Ko et regroupe les absences de 75 personnes sur 3,5 ans

Bonjour,

pas étonnant !

la seul solution est de mettre un code dans la cellule, de faire les calculs par rapport à ce code et de conserver les couleurs comme résultante de ce code via une MFC

voici un exemple qui pourrait convenir

on peut intervertir lignes et colonnes pour ensuite faire un TCD

@Raimana ... as-tu testé les propositions qui devraient accélérer notablement ton fichier ?