Microsoft 365 Compter cellules fusionnées de couleurs indentiques

polog57

XLDnaute Nouveau
Bonjour,



Afin de gérer un calendrier sur Excel, j’essaie de compter le nombre de cellules d’une couleur identique.

J’ai bien réussi à entrer un module couleur qui me permet d’identifier la couleur de fond de la cellule, mais le problème provient des cellules fusionnées.

Excel ne les compte pas comme cellules uniques mais multiples.

Dans le fichier exemple que je joins, le nombre de cellules bleues devrait être 4 avec les cellules fusionnées, mais en fait la formule me ramène 20 car elle compte toute les lignes.



Je vous remercie pour votre aide.

Cordialement

Paul
 

Pièces jointes

  • Couleurs et Cellules fusionnees.xlsx
    17.7 KB · Affichages: 10

Dranreb

XLDnaute Barbatruc
Bonjour.
Il ne peut y avoir de code dans le classeur .xlsx joint. Alors j'ai réécrit comme ceci votre Function dans un nouveau module standard :
VB:
Option Explicit
Function Couleur(ByVal Cel As Range) As String
   If Cel.Address = Cel.MergeArea(1, 1).Address Then
      Couleur = "&H" & Right$("00000" & Hex(Cel.Interior.Color), 6) & "&"
   Else
      Couleur = ""
      End If
   End Function
Les validations matricielles sont inutiles pour toutes les formules.
Mais il ne faut plus demander la couleur d'une cellule qui n'est pas la première du groupe fusionné: elle sera toujours ""
=NB.SI($C$2:$C$31;Couleur(B9)) donne bien 4 mais
=NB.SI($C$2:$C$31;Couleur(B13)) donne 17 parce qu'il y a 17 cellules qui, comme la B13, ne sont pas les 1ères de leurs groupes de cellules fusionnées.
 
Dernière édition:

polog57

XLDnaute Nouveau
Merci beaucoup mais je n'arrive pas à appliquer votre formule, ce qui est très probablement dû à mes connaissances très lacunaires d'Excel.
Comment faire à partir de cette formule pour déterminer le nombre de cellules bleues dans une cellule précise?
Que dois-je changer dans la formule si je veux changer la couleur et passer du bleu au jaune?
Désolé de vous ennuyer avec mon ignorance.
Cordialement
Paul
 

Dranreb

XLDnaute Barbatruc
Rien à changer dans les formules, sauf les valider normalement et non en matriciel.
Réécrite comme ça, elle admet un argument VRAI permettant de restituer aussi la couleur d'une cellule qui n'est pas la 1ère de sa plage fusionnée :
Code:
Function Couleur(ByVal Cel As Range, Optional ByVal Milieu As Boolean) As String
   Milieu = Milieu Or Cel.Address = Cel.MergeArea(1, 1).Address
   If Milieu Then
      Couleur = "&H" & Right$("00000" & Hex(Cel.Interior.Color), 6) & "&"
   Else
      Couleur = ""
      End If
   End Function
En C2, à propager sur 31 lignes :
Code:
=Couleur(B2)
Exemple de formule qui donne 17 (parce qu'il y a 17 cellules non 1ères de leurs plages fusionnées) :
Code:
=NB.SI($C$2:$C$32;Couleur(B13))
Exemple de formules qui donnent toutes deux 4 :
Code:
=NB.SI($C$2:$C$32;Couleur(B9))
=NB.SI($C$2:$C$32;Couleur(B13;VRAI))
 

polog57

XLDnaute Nouveau
Merci beaucoup.
Cela me paraît beaucoup plus simple et cela fonctionne.
Paul
Je suis allé trop vite.
Quand je fais un copier - coller de la feuille dans un autre classeur, certaines données semblent se perdre et cela ne fonctionne plus. La formule =@CouleurCellule($D$3:$D$33;A3) n'est pas transposable d'un classeur à un autre? Il y a autre chose à enregistrer (module?)
Merci
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Cela me paraît beaucoup plus simple et cela fonctionne.
Paul
Connaissant la qualité d'ouvrage de Dranreb, m'étonnerait que sa proposition ne fonctionne pas... :rolleyes:
Par contre, que tu n'arrives pas à l'implémenter, cela ne m'étonnerait point ;)

NB: Message écrit (non pas à l'encre de tes yeux) mais avec mon stylo "Ironie même le samedi")
;)
Tout cela bien sûr dans un registre amical ;)
 

polog57

XLDnaute Nouveau
Bonjour le fil


Connaissant la qualité d'ouvrage de Dranreb, m'étonnerait que sa proposition ne fonctionne pas... :rolleyes:
Par contre, que tu n'arrives pas à l'implémenter, cela ne m'étonnerait point ;)

NB: Message écrit (non pas à l'encre de tes yeux) mais avec mon stylo "Ironie même le samedi")
;)
Tout cela bien sûr dans un registre amical ;)
C'est ce que je m'étais dit aussi.
 

Dranreb

XLDnaute Barbatruc
En fait la cause probable de ce que vous dites c'est simplement qu'une formule n'est réévaluée que si la valeur de ses antécédents change.
Le problème peut généralement se résoudre en ajoutant comme 1ère instruction exécutable dans la fonction perso : Application.Volatile
Mais il ne faut l'utilser que si on est absolument sûr qu'elle est nécessaire.
 

patricktoulon

XLDnaute Barbatruc
bonjour le fil
a adapter en fonction
VB:
Sub test()
    Set dico = CreateObject("scripting.dictionary")
    For Each cel In Range("A1:g1").Cells
        If Not dico.exists(cel.MergeArea.Address) Then
            dico(cel.MergeArea.Address) = cel.Interior.Color & ":" & cel.MergeArea.Cells.Count
        Else
        End If
    Next
    For Each elem In dico
        Debug.Print elem & ":" & dico(elem)
    Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T