Compter les couleurs de cellules

Private Sub Worksheet_Calculate()
MsgBox "Recalcul"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[COLOR="Red"]Range("A11:R11").Value = Range("A11:R11").Value[/COLOR]
End Sub

Sub CompteCouleur()
Dim ncol%, total%(), i&, j%, coul
With [B3:I12] 'à adapter
    ncol = .Columns.Count
    ReDim total(1 To .Rows.Count, 1 To 1)
    For i = 1 To .Rows.Count
        For j = 1 To ncol
            coul = .Cells(i, j).Interior.ColorIndex
            total(i, 1) = total(i, 1) + (coul <> xlNone) * (coul <> 2) 'ni incolore ni blanc
    Next j, i
    .Columns(ncol + 2) = total 'restitution
End With
End Sub

Sub CompteCouleur()
Dim n As Byte, ncol%, total%(), i&, j%, coul
With [B4:I13,O4:V13] 'plages disjointes, à adapter
    For n = 1 To .Areas.Count
        With .Areas(n)
            ncol = .Columns.Count
            ReDim total(1 To .Rows.Count, 1 To 1)
            For i = 1 To .Rows.Count
                For j = 1 To ncol
                    coul = .Cells(i, j).Interior.ColorIndex
                    total(i, 1) = total(i, 1) + (coul <> xlNone) * (coul <> 2) 'ni incolore ni blanc
            Next j, i
            .Columns(ncol + IIf(n = 1, 2, -9)) = total 'restitution
        End With
    Next n
End With
End Sub

Sub CompteCouleur_individuel()
Dim resu(), cel As Range, i As Variant
With [C7:C27] 'tableau des résultats, à adapter
    ReDim resu(1 To .Rows.Count, 1 To 1)
    For Each cel In [B4:I13] 'tableau à étudier
        i = Application.Match(cel.Interior.ColorIndex, .Columns(0), 0)
        If IsNumeric(i) Then resu(i, 1) = resu(i, 1) + 1
    Next
    .Value = resu  'restitution
End With
End Sub