XL 2016 Compter les cellules en fonction de la couleur issu du MFC

Rabeto

XLDnaute Occasionnel
Bonjour,

J'ai cherché une solution mais ce que j'ai trouvé ne correspond pas à ce que je souhaite avoir.
Si quelqu'un peut m'aider.

Je souhaite compter le nombre de cellule qui ont des couleurs issues d'une MEFC
 

Pièces jointes

  • Nb couleur MFC.xlsx
    9.8 KB · Affichages: 22
Solution
Bonjour Patrick, le forum,

Oui c'est moi qui avais la comprenette difficile :rolleyes:

Alors avec le fichier de mon post #10 on utilisera 2 dictionary :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, dd As Object, c As Range, coul&
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
For Each c In [D3:M17] 'plage à adapter
    coul = c.DisplayFormat.Interior.Color
    d(coul) = d(coul) + 1 'comptage
    dd(coul) = dd(coul) + Val(Replace(c, ",", ".")) 'somme
Next
Application.EnableEvents = False 'désactive les évènements
For Each c In [A4:A6] 'plage à adapter
    coul = c.Interior.Color
    c = "Nombre " & d(coul) & " - Somme " & Format(dd(coul), "0.00")
Next...

Victor21

XLDnaute Barbatruc
Re,
???
Si vous insérez une colonne avec des valeurs = ou > à 7, les mefc existantes s'appliqueront, et leur décompte s'ajustera. Rien que de très normal.
Vous l'auriez constaté si vous l'aviez testé :)
PS : idem en cas d'insertion de ligne(s)
 

riton00

XLDnaute Impliqué
Bonjour,

Merci pour votre retour,
Comment avez vous trouver les numéros des couleurs, si par exemple je vais ajouter une autre cellules avec d'autre couleur, comment faire?
Si toujours partant pour retrouver le code couleur, alors voir Pj
Pas oublier d'activer les macros pour un fonctionnement normal

Slts
 

Pièces jointes

  • Retrouver les codes couleurs.xls
    39 KB · Affichages: 13

job75

XLDnaute Barbatruc
Bonjour à tous,

Voyez le fichier joint et cette macro évènementielle dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, c As Range, coul&
Set d = CreateObject("Scripting.Dictionary")
For Each c In [D3:M17] 'plage à adapter
    coul = c.DisplayFormat.Interior.Color
    d(coul) = d(coul) + 1 'comptage
Next
Application.EnableEvents = False 'désactive les évènements
For Each c In [A4:A6] 'plage à adapter
    c = d(c.Interior.Color)
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
 

Pièces jointes

  • Nb couleur MFC(1).xlsm
    17.3 KB · Affichages: 15

job75

XLDnaute Barbatruc
Ce fichier (2) est plus intéressant car on y liste les couleurs utilisées par les MFC :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, c As Range, coul&, n&
Set d = CreateObject("Scripting.Dictionary")
For Each c In [D3:M17] 'plage à adapter
    coul = c.DisplayFormat.Interior.Color
    d(coul) = d(coul) + 1 'comptage
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A4] '1ère cellule de destination, à adapter
    n = d.Count
    If n Then
        .Resize(n) = Application.Transpose(d.keys) 'codes couleurs
        For Each c In .Resize(n)
            c.Interior.Color = c.Value 'colore
        Next
        .Resize(n) = Application.Transpose(d.items) 'nombres
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
 

Pièces jointes

  • Nb couleur MFC(2).xlsm
    18.7 KB · Affichages: 19

Chris769375

XLDnaute Nouveau
Bonjour à tous,

Voyez le fichier joint et cette macro évènementielle dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, c As Range, coul&
Set d = CreateObject("Scripting.Dictionary")
For Each c In [D3:M17] 'plage à adapter
    coul = c.DisplayFormat.Interior.Color
    d(coul) = d(coul) + 1 'comptage
Next
Application.EnableEvents = False 'désactive les évènements
For Each c In [A4:A6] 'plage à adapter
    c = d(c.Interior.Color)
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
Bonjour,

Est-il possible d'avoir en plus du message #10 la somme de toutes les cellules de couleur

Merci d'avance
 

Discussions similaires

Réponses
9
Affichages
902

Statistiques des forums

Discussions
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin