Compter dans les cellules de couleur.

[Manu62]

Bonjour

Je recherche une formule qui permet de faire la somme de toutes les cellules de même couleur.

Cf petit fichier exemple, avec le résultat attendu.

merci de votre aide

Manu

 

[Manu62]

Re : Compter dans les cellules de couleur.

Bonjour

Oui j'ai vu mais pas trouvez avec somme...

Comment puis je mettre la function somme de ce type de code..




Function CompteCouleurFond(champ As Range, couleurFond)
Application.Volatile
Dim c, temp
temp = 0
For Each c In champ
If c.Interior.ColorIndex = couleurFond Then
temp = temp + 1
End If
Next c
CompteCouleurFond = temp
End Function



merci de votre retour

Manu

 

[13GIBE59]

Re : Compter dans les cellules de couleur.

Bonjour Manu, bonjour cc

Essaie ça :

Function SommeRouge(Plage As Range)
For Each cell In Plage
If cell.Interior.ColorIndex = 3 Then vSomme = vSomme + cell.Value
Next
SommeRouge = vSomme
End Function

Les codes couleurs en pièce jointe.

 

[ROGER2327]

Re : Compter dans les cellules de couleur.

Bonjour à tous

Une autre proposition (à placer dans un module standard) :

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

Placer

=sommecouleur($A$1:$C$6)

en J1 et recopier vers le bas.​

ROGER2327
#5224

Vendredi 20 Palotin 138 (Saint Ti Belot, séide, SQ)
20 Floréal An CCXIX
2011-W19-1T13:56:00Z