Microsoft 365 Compter les couleur avec MFC

  • Initiateur de la discussion Initiateur de la discussion David
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

David

XLDnaute Occasionnel
Bonjour à tous,

J'ai un soucis pour compter les cellules de couleur par MFC, le résultat est ok, quand je regarde dans le détail, mais le total me renvoi #VALEUR
1718740835570.png



VB:
Function CompterCouleur(PlageCouleur As Range, Couleur As Range)
Dim CodeCouleur As Integer
Dim NbrCouleur As Integer
CodeCouleur = Couleur.Interior.Color
Set CCell = PlageCouleur
For Each CCell In PlageCouleur
  If CCell.DisplayFormat.Interior.Color = CodeCouleur Then
    NbrCouleur = NbrCouleur + 1
  End If
Next CCell
CompterCouleur = NbrCouleur
End Function

Je vous joins mon fichier parce que la je ne comprend pas.

Merci de votre aide
 

Pièces jointes

Bonjour à tous,

J'ai un soucis pour compter les cellules de couleur par MFC, le résultat est ok, quand je regarde dans le détail, mais le total me renvoi #VALEUR
Regarde la pièce jointe 1199093


VB:
Function CompterCouleur(PlageCouleur As Range, Couleur As Range)
Dim CodeCouleur As Integer
Dim NbrCouleur As Integer
CodeCouleur = Couleur.Interior.Color
Set CCell = PlageCouleur
For Each CCell In PlageCouleur
  If CCell.DisplayFormat.Interior.Color = CodeCouleur Then
    NbrCouleur = NbrCouleur + 1
  End If
Next CCell
CompterCouleur = NbrCouleur
End Function

Je vous joins mon fichier parce que la je ne comprend pas.

Merci de votre aide
Bonsoir,
en C5, à recopier vers la droite :
VB:
=SOMMEPROD(--((C2:C4)<$H2-0,49))+SOMMEPROD(--((C2:C4)>$H2+0,49))
Cordialement,
 
Bonjour David, le forum,
Il faut savoir que DisplayFormat va bien dans une procédure Sub mais pas dans une fonction.
VB:
Sub CompterCouleur()
Dim Couleur As Range, Compte As Range, CodeCouleur&, c As Range, NbrCouleur&, cc As Range
Set Couleur = [C20]
Set Compte = [C5:J5]
CodeCouleur = Couleur.Interior.Color
For Each c In Compte
    NbrCouleur& = 0
    For Each cc In Range(Cells(1, c.Column), c(0))
        If cc.DisplayFormat.Interior.Color = CodeCouleur Then NbrCouleur = NbrCouleur + 1
    Next cc
    c = NbrCouleur
Next c
End Sub
A+
 

Pièces jointes

Bonjour @David 🙂, à tous 😉,

Il y a une astuce ( pas de ma pomme 🙁 ) qui permet de faire une fonction personnalisée pour compter les couleurs avec DisplayFormat.

En C5, placez la formule suivante : =CompterCouleur(C2:C4;$C$11) à copier vers la droite.
Avec le code suivant dans un module :
VB:
Option Explicit

Function CompterCouleur(plage As Range, cellCouleur As Range) As Long
Dim refCoul, x, nbr&
   Application.Volatile
   refCoul = cellCouleur.Interior.Color
   For Each x In plage: nbr = nbr - (DFColor(x) = refCoul): Next
   CompterCouleur = nbr
End Function

Function DFColor(ByVal R As Range) As Double
   Application.Volatile
   DFColor = Evaluate("Helper(" & R.Address() & ")")
End Function

Private Function Helper(ByVal R As Range) As Double
   Helper = R.DisplayFormat.Interior.Color
End Function

nota : comme un changement de format ne provoque aucun évènement intercepté par Excel, n'oubliez pas de forcer le calcul après tout changement de couleur (dans la MFC ou dans la cellule de référence de la couleur) - un des moyens pour forcer le calcul : se placer dans une cellule de la plage et (re)valider. C'est valable pour la fonction et aussi pour les Sub.
 

Pièces jointes

Dernière édition:
Bonjoy,


Ben comme ça on est au moins deux... 😅

Ça doit compter quoi ??? Sur quelle plage ?
Pourquoi le SommeProd de l'ami Gégé ne convient-il pas ?
Merci, mais je ne comprend juste pas pourquoi ç n'affiche pas le résultat qui est bon, sinon je comprend encore ce que je fais.
Pour l'ami Gégé il faudrait le faire ligne par ligne et j'ai beaucoup de ligne, j'ai commencé par faire ce qu'il m'a proposé.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
24
Affichages
2 K
Retour