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

alain160

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
Bonjour Alain,
En VBA c'est simple avec cette fonction :
VB:
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.
 

Pièces jointes

  • Classeur1.xlsm
    13.7 KB · Affichages: 2
Dernière édition:

crocrocro

XLDnaute Impliqué
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
VB:
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
 
Dernière édition:

alain160

XLDnaute Nouveau
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
 
Dernière édition:

crocrocro

XLDnaute Impliqué
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
VB:
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
1732901586216.png
 

Discussions similaires

Réponses
19
Affichages
709
Réponses
34
Affichages
1 K

Statistiques des forums

Discussions
314 898
Messages
2 114 009
Membres
112 073
dernier inscrit
dimakhadra