Bonsoir tout le monde,
Ci dessous, une version différente sans fonction, mais par vba.
Cellule A1 permet de prendre la couleur rouge de l'écriture.
à voir si cela vous convient...
le code :
Sub recherche_ecriture_rouge()
Dim Chn As String
Dim lesval() As String
Dim NbRouge As Long
Dim Nblect As Long
Dim k As Long
Dim n As Long
Dim li As Long
Dim couleur As Long
Dim compte As Boolean
Dim nbPopTotal As Long
Dim nbPopNormal As Long
Dim nbPopRouge As Long
Dim ecrnoir As Long
Dim ecrrouge As Long
Dim totalecr As Long
With Sheets(1)
couleur = .Cells(1, 1).Font.Color
n = .Cells(Rows.Count, 2).End(xlUp).Row
For li = 2 To n
compte = False
Nblect = Nblect + 1
If .Cells(li, 2).Font.Color = couleur Then NbRouge = NbRouge + 1: compte = True
Chn = .Cells(li, 2)
lesval = Split(Chn, ",")
For k = 0 To UBound(lesval)
totalecr = totalecr + 1
nbPopTotal = nbPopTotal + Val(lesval(k))
If compte Then
ecrrouge = ecrrouge + 1
nbPopRouge = nbPopRouge + Val(lesval(k))
Else
ecrnoir = ecrnoir + 1
nbPopNormal = nbPopNormal + Val(lesval(k))
End If
Next k
Next li
.Cells(4, 5) = "Nombre cellule non-vide : " & Nblect
.Cells(5, 5) = "Nombre cellule rouge : " & NbRouge
.Cells(6, 5) = "total de nombre : " & totalecr
.Cells(7, 5) = "total de nombre non-rouge : " & ecrnoir
.Cells(8, 5) = "total de nombre rouge : " & ecrrouge
.Cells(9, 5) = "calcul population totale : " & nbPopTotal
.Cells(10, 5) = "calcul population rouge : " & nbPopRouge
.Cells(11, 5) = "calcul population non-rouge : " & nbPopNormal
End With
End Sub
MFerrand, très belle fonction personnalisée...