Microsoft 365 Compter les couleur avec MFC

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

  • testcouleur.xlsm
    16.2 KB · Affichages: 7

Gégé-45550

XLDnaute Accro
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,
 

job75

XLDnaute Barbatruc
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

  • testcouleur.xlsm
    17.6 KB · Affichages: 3

mapomme

XLDnaute Barbatruc
Supporter XLD
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

  • David- test couleur- v1.xlsm
    16.2 KB · Affichages: 3
Dernière édition:

David

XLDnaute Occasionnel
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é.
 

Discussions similaires

Statistiques des forums

Discussions
313 019
Messages
2 094 431
Membres
106 022
dernier inscrit
mustlagz1960