XL 2016 compter les cellules qui contiennent du TEXTE d'une certaine couleur

[alain160]

Bonjour,
Il est facile sur Excel de compter les cellules Coloriées, mais je n'ai pas trouvé comment compter des cellules qui contiennent du TEXTE d'une certaine couleur.
Avez vous une solution ?
Merci par avance

 

[sylvanu]

Bonjour Alain,
En VBA c'est simple avec cette fonction :

Function Compter(Plage, Coul)
Couleur = Coul.Font.Color
For Each C In Plage
    If C.Font.Color = Couleur Then Compter = Compter + 1
Next C
End Function

La syntaxe est : =Compter(Plage; cellule qui donne la couleur)
NB: Cette macro ne traite pas les chaines dont la couleur est donnée par une MFC.

 

[crocrocro]

bonjour le fil, @alain160, @sylvanu
si on doit tester au moins un caractère de la couleur, le code ci-dessous pour un test en dur de la cellule courant avec rouge comme couleur de test

Sub testcouleur()
Dim MaRange As Range
Dim MaCouleur
Dim Ok As Boolean
    MaCouleur = RGB(255, 0, 0)
    Set MaRange = Selection
    If MaRange.Font.Color = MaCouleur Then Ok = True Else Ok = False
    MsgBox "toute la cellule " & Ok
    Ok = False
    For i = 1 To Len(MaRange.Value)
        If MaRange.Characters(i, 1).Font.Color = MaCouleur Then Ok = True
    Next i
    MsgBox "au moins 1 caracttère " & Ok
End Sub

 

[alain160]

Merci beaucoup sylvanu
Effectivement, ça fonctionne
Je crois que pour ce genre recherche, le VBA est incontournable.
Cordialement

 

[alain160]

Sylvanu et Crocrocro , merci à tous les 2
La fonction Compter fonctionne bien, mais j’ai été étonné par son comportement.
Lorsque je rajoute du texte dans une cellule (concerné par le champ du calcul),le compteur augmente de 1…… .....ce qui est normal.
Mais lorsque je supprime le texte de cette cellule le compteur ne bouge pas.
Pour que le compteur revienne à la normale, Il faut que je reformate la cellule identique à une cellule vierge ????????
Ce qui est piegeux ..
Il faut donc rajouter une condition ; que la cellule ne soit pas vide
If C.Font.Color = Couleur And C <> "" Then Compter = Compter + 1
Cordialement

 

[crocrocro]

voici une proposition où j'ai modifié la fonction de @sylvanu
J'ai ajouté 2 paramètres booléens pour prendre en compte ou pas les cellules vides, les couleurs de partie de texte

Sub CompterLesCouleurs()
Dim Nb As Integer
    Nb = CompterCouleur(Range("B2:B20"), Range("A1"), True, True)
    MsgBox Nb
End Sub

Function CompterCouleur(pPlage As Range, pRangeCouleur As Range, CelluleComplète As Boolean, IgnorerCellulesVide As Boolean)
Dim Cellule As Range
Dim TrouveCaractere As Boolean
Dim i As Integer
    For Each Cellule In pPlage
        If CelluleComplète Then
            If Cellule.Font.Color = pRangeCouleur.Font.Color Then
                If Not (IgnorerCellulesVide) Or Cellule.Value <> "" Then
                    CompterCouleur = CompterCouleur + 1
                End If
            End If
        Else
            TrouveCaractere = False
            For i = 1 To Len(Cellule.Value)
                If Cellule.Characters(i, 1).Font.Color = pRangeCouleur.Font.Color Then
                    TrouveCaractere = True
                    Exit For
                End If
            Next i
            If TrouveCaractere Then CompterCouleur = CompterCouleur + 1
        End If

    Next Cellule
End Function