Compter le nombre de Cellule avec une police noir

Bonjour à Tous,

Je cherche une formule pour compter le nombre de cellule avec la police de caractère NOIR de B2 à B350.

J'ai trouvé sur le Net en VBA:

Public Function cumulcouleur(plage As Range, col As Range)
Dim elm As Object
Application.Volatile
cumulcouleur = 0
For Each elm In plage
If elm.Font.ColorIndex = col.Font.ColorIndex Then
cumulcouleur = cumulcouleur + 1
End If
Next elm
End Function

Et la formule: =cumulcouleur(B2:B350;A3). Le A3, est la cellule exemple de couleur recherchée.

Ça fonctionne sur une nouvelle feuille de calcul, mais sur mon fichier ne fonctionne pas.

Peut-être pcq j'ai un MFC.

Je joins mon fichier exemple.

Merci

Jean

Moé Kolisse, le forum,

Il y a une différence entre la couleur de la police de la cellule et la couleur de la police affichée par une MFC.

Quelle couleur souhaites-tu compter ? Celle de la cellule? ou Celle de l'affichage?

LaCéline

Bonjour laceline,

J'ai besoin celle de la MFC. Celle qui est afficher dans le fichier.

Merci

Jean.

Bonjour,

Un exemple à adapter.

La condition dans la procédure correspond à la formule de la MFC.

Cdlt.

Option Explicit

Public Sub TEST()
Dim n As Long, cpt As Double, I As Long
    With ActiveSheet
        n = .Cells(Rows.Count, 2).End(xlUp).Row
        For I = 2 To n
            If .Cells(I, 4) <= .Cells(I, 5) Then cpt = cpt + 1
        Next I
    End With
    MsgBox "Total : " & Format(cpt, "#,##0")
End Sub

Bonjour Jean-Eric,

J'ai fait le test avec votre code, et ça me donne comme résultat: 48. Le résultat que j'aimerais avoir est 18. (dans ce cas-ci).

18 étant le nombre de cellule écris en noir en colonne B.

J'ai tenté de modifier le code, mais je ne le comprend pas assez le code pour savoir quoi modifier.

Je joins mon essai et le résultat en photo.

Merci Beaucoup

Jean

Moé Kolisse, Jean-Eric, le forum,

La condition s'avérait sur d'autres cellules.

Une proposition de modification.

Public Sub TEST()
Dim n As Long, cpt As Double, I As Long
    With ActiveSheet
        n = .Cells(Rows.Count, 2).End(xlUp).Row
        For I = 2 To n
            If .Cells(I, 4) <= .Cells(I, 5) And .Cells(I, 4) <> .Cells(I, 6) Then cpt = cpt + 1
        Next I
    End With
    MsgBox "Total : " & Format(cpt, "#,##0")
End Sub

LaCéline

Bonjour laceline,

Le code modifié fonctionne très bien.

Je vais fermer le fil, mais si vous avez du temps, j'aimerais que le résultat s'inscrive en A1, au lieu du MsgBox.

Un TRÈS GROS MERCI À VOUS ET À JEAN-ERIC.

Jean

Moé Kolisse, Jean-Eric, le fortum,

    Public Sub TEST()
    Dim n As Long, cpt As Double, I As Long
        With ActiveSheet
            n = .Cells(Rows.Count, 2).End(xlUp).Row
            For I = 2 To n
                If .Cells(I, 4) <= .Cells(I, 5) And .Cells(I, 4) <> .Cells(I, 6) Then cpt = cpt + 1
            Next I
        .cells(1, 1) = "Total : " & Format(cpt, "#,##0")  ' J'ai modifié cette ligne
        End With                                          ' et déplacé cette ligne en dessous
    End Sub

LaCéline

Bonjour laceline,

GROS MERCI, c'est NICKEL.

Jean