XL 2019 Code VBA - Addition de Cellules en couleur avec Texte

[Caninge]

Bonjour à tous,

j'ai récupéré une macro pour additionner des cellules colorisés.
sauf qu'elle ne comptabilise pas les cellules avec du texte.
Il y a peut-être une modification à apporter !
Je vous remercie de bien vouloir me donner un coup de main.

Function CountCcolor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
If datax.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1
End If
Next datax
End Function

 

[Caninge]

J'ai oublié le fichier mince !!!!!!!!!

 

[job75]

Pas ouvert votre dernier fichier, fichier (2) avec cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coul&, colonne As Range, n&, c As Range
coul = [A1].Interior.Color
Application.EnableEvents = False 'désactive les évènements
For Each colonne In [C4:G21].Columns 'plage à adapter
    n = 0
    For Each c In colonne.Cells
        If c.DisplayFormat.Interior.Color = coul Then n = n + 1
    Next c
    colonne.Cells(-1) = n
Next colonne
Application.EnableEvents = True 'réactive les évènements
End Sub

Bonne nuit.

 

[job75]

Bonjour Caninge, le forum,

En fait le VBA est inutile, formule en C2 à tirer vers la droite :

=SIGNE(NB.SI($C15:$G21;C4))+SOMMEPROD(SIGNE(NB.SI($C4:$G4;C15:C21)))

Elle s'appuie sur les formules des 2 MFC.

A+

 

[Caninge]

Bonjour sylvanu, job75

Apparemment la formule fonctionne bien. Je vais pouvoir continuer mon arbre généalogique.
comme quoi parfois il ne faut pas se compliquer et trouver une solution plus facile.
Mais pour moi c'est compliqué. Je vais réparer mon aspirateur. La par contre je suis plus adroit.
Je vous remercie et vous souhaite une bonne journée et à Bientôt.
CANINGE