Function sommecouleur(r)
Application.Volatile
sommecouleur = toto(r.Address, Application.Caller.Address)
End Function
Function toto(rg1$, rg2$)
Dim c&, i&, oCl(), oDat(), oPlg As Range, oCel As Range
Set oPlg = Range(rg2)
ReDim oCl(1 To oPlg.Count)
For i = 1 To oPlg.Count
oCl(i) = oPlg(i).Interior.ColorIndex
Next
ReDim oDat(1 To UBound(oCl), 1 To 1)
For Each oCel In Range(rg1).Cells
c = oCel.Interior.ColorIndex
For i = 1 To UBound(oCl)
If c = oCl(i) Then
oDat(i, 1) = oDat(i, 1) + oCel.Value
Exit For
End If
Next
Next
toto = oDat
End Function