XL 2013 Comptage de cellule colorisée

Lericounet06

XLDnaute Junior
Bonjour à tous,

j'essaye désespérément à trouver une solution à mon problème mais sans résultats.

explication :

Je souhaiterais compter les cellules colorées en rouge dans une colonne, en rose et en verte dans une autre (fichier joint avec explication)

Pouvez-vous m'aider svp ?

Merci d'avance

Bonne journée

Eric
 

Pièces jointes

  • Test.xlsx
    17.1 KB · Affichages: 5

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Lericounet06 :), @Usine à gaz ;),

Cliquer sur le bouton Hop!

L'avantage de la macro, c'est qu'elle est indépendante des formules de la MFC et des couleurs indiquées dans la MFC. A chaque exécution, elle reconstruit la liste des couleurs et des nombres de cellules avec ces couleurs (la macro ne prend pas en compte les formules mais simplement les couleurs résultantes dues à l'application de la MFC). On peut donc changer les formules, les couleurs sans que la macro ne soit à modifier.

Le code est dans le module de la feuille "Feuil1" :
VB:
Sub compter()
Dim der, i&, j&, n, coul&
   Application.ScreenUpdating = False
   Range("g2:h" & Rows.Count).Clear
   der = Application.Max(Application.IfError(Application.Match(9 ^ 99, Columns("d:d")), 0), Application.IfError(Application.Match(String(255, "z"), Columns("d:d")), 0))
   i = Application.Max(Application.IfError(Application.Match(9 ^ 99, Columns("e:e")), 0), Application.IfError(Application.Match(String(255, "z"), Columns("e:e")), 0))
   If i > der Then der = i
   For i = 2 To der
      For j = 0 To 1
         coul = Cells(i, 4 + j).DisplayFormat.Interior.Color
         On Error Resume Next
         n = Application.Match(coul, Columns("g:g"), 0)
         On Error GoTo 0
         If IsError(n) Then
            n = Application.Max(Application.IfError(Application.Match(9 ^ 99, Columns("g:g")), 0), Application.IfError(Application.Match(String(255, "z"), Columns("g:g")), 0))
            Cells(n + 1, "g") = coul
            Cells(n + 1, "g").Interior.Color = coul
            Cells(n + 1, "h") = Cells(n + 1, "h") + 1
         Else
            Cells(n, "h") = Cells(n, "h") + 1
         End If
      Next j
   Next i
   Range("g2").CurrentRegion.Borders.LineStyle = xlContinuous
   Range("g2:g" & Rows.Count).ClearContents
End Sub
 

Pièces jointes

  • Lericounet06- compter couleur MFC- v1.xlsm
    25.5 KB · Affichages: 8
Dernière édition:

Lericounet06

XLDnaute Junior
Merci à tous pour vos réponses comme d'habitude.
J'ai réussi à faire un VBA en suivant un tuto youtube et çà fonctionne bien.
Dés que je rentre de vacances, je regarderai en détail vos fichiers pour comparer la meilleures solution pour moi.

Un grand merci à tous et bonnes vacances pour ceux qui y sont

Eric
 

Discussions similaires

Réponses
2
Affichages
166
  • Résolu(e)
Microsoft 365 planning
Réponses
17
Affichages
692

Statistiques des forums

Discussions
312 222
Messages
2 086 395
Membres
103 200
dernier inscrit
pascalgip