Compter les couleurs de cellules avce une MFC ( encore !!!!!)

[osaca78]

Bonjour

Malgré de nombreux topics sur ce sujet , je ne trouve pas la solution à mon probleme (basic) de comptage du nombre cellules colorées ( en 3 couleurs rouge , jaune , vert) aprés une MFC.
j'ai déja passé qqs heures en bidouile et lecture de forums , mais sans succés dans mon cas !
Merci d'avance pour votre aide

 

[Pierrot93]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Bonjour,

regarde cefil trés récent, notamment la proposition de Roger :

https://www.excel-downloads.com/thr...lules-dun-champ-ayant-une-couleur-mfc.209766/

bonne journée
@+

 

[osaca78]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Merci Pierrot93

Je n'ai pas réussi à adapter la macro de Roger à mon exemple .
J'ai changé les parametres de champs (et mis J5 ,J9 et L2 )pour les adapter à mon ficheir mais ca ne fonctionne pas .
Voir ci-dessous:

Private Sub Worksheet_BeforeDoubleClick(ByVal Cible As Range, Contremander As Boolean)
If Not Intersect(Cible, Range("j5:j9")) Is Nothing Then toto Range("j5:j9").Cells, Range("l2").Cells: Contremander = True
End Sub


Comme je ne connais pas le VBA , je ne comprend pas comment fonctionne la macro " toto"

Sub toto(plage As Range, cellule As Range)
Dim i, cel, w, c()
Set w = plage.Cells(1, 1).FormatConditions
ReDim c(1 To w.Count, 2)
For i = 1 To w.Count
c(i, 0) = w(i).Interior.Color
c(i, 1) = 0
c(i, 2) = w(i).Font.Color
Next
With plage
For Each cel In .Cells
For i = 1 To w.Count
If cel.DisplayFormat.Interior.Color = c(i, 0) Then c(i, 1) = c(i, 1) + 1
Next
Next
End With
With cellule
.Resize(1, 2) = Array("couleur", "nombre")
For i = 1 To w.Count
.Offset(i).Interior.Color = c(i, 0)
.Offset(i).Font.Color = c(i, 2)
Next
.Offset(1).Resize(w.Count, 2).Value = c
End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Cible As Range, Contremander As Boolean)

If Not Intersect(Cible, Range("B3:E6")) Is Nothing Then toto Range("B3:E6").Cells, Range("C9").Cells: Contremander = True
End Sub

 

[piga25]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Bonjour,

Votre fichier

Ne pas oublier de faire un double clic dans la plage J5:J9

 

[osaca78]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Merci Piga ,mais je n'arrive pas à faire marcher le ficheir que tu m'as renvoyé .
=> les valeurs des cellules K12:K14 ne se mettent pas à jour malgré le double-clik sur les cellules J5:J9

 

[piga25]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Re

Oups erreur dans le code

mettre celui-ci dans le code de la feuille

Code VB:
Option Explicit


Sub toto(plage As Range, cellule As Range)
Dim i, cel, w, c()
Set w = plage.Cells(1, 1).FormatConditions
ReDim c(1 To w.Count, 2)
For i = 1 To w.Count
c(i, 0) = w(i).Interior.Color
c(i, 1) = 0
c(i, 2) = w(i).Font.Color
Next
With plage
For Each cel In .Cells
For i = 1 To w.Count
If cel.DisplayFormat.Interior.Color = c(i, 0) Then c(i, 1) = c(i, 1) + 1
Next
Next
End With
With cellule
.Resize(1, 2) = Array("couleur", "nombre")
For i = 1 To w.Count
.Offset(i).Interior.Color = c(i, 0)
.Offset(i).Font.Color = c(i, 2)
Next
.Offset(1).Resize(w.Count, 2).Value = c
End With
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Cible As Range, Contremander As Boolean)


If Not Intersect(Cible, [plage]) Is Nothing Then toto [plage].Cells, Range("J12").Cells: Contremander = True
End Sub

 

[osaca78]

Re : Compter les couleurs de cellules avce une MFC ( encore !!!!!)

Super !!! ca marche !
Merci