Addition cellule en rouge

J.-P.

XLDnaute Occasionnel
Je cherche le code pour additioné des cellules en rouge uniquement en rouge sur une ligne.

Merci de votre aide

J.-P.
 

JNP

XLDnaute Barbatruc
Re : Addition cellule en rouge

Bonjour J.-P. :),
Code:
Function Couleur(Plage As Range, RéfCouleur As Range) As Long
Application.Volatile
Couleur = 0
Dim Cellule As Range
For Each Cellule In Plage
If Cellule.Interior.Color = RéfCouleur.Interior.Color Then Couleur = Couleur + 1
Next
End Function
par exemple.
Bonne journée :cool:
Ajout : Salut Bertro, moi, c'est JNP :D
Ajout 2 : Tout excusé sans problème... C'est souvent que les gens se trompent !
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Addition cellule en rouge

Bonjour le JP, bonjour le forum,

Sujet maintes fois traité une recherche sur le forum t'aurait évité de poster... Une proposition :
Code:
Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim s As Double 'décalre la variable s (Somme)
For Each cel In Rows(1).Cells 'boucle sur toutes les cellule de la ligne 1 (tu adapteras à ton cas)
    'si le motif de la cellule est rouge définit la somme
    If cel.Interior.ColorIndex = 3 Then s = s + CDbl(cel.Value)
Next cel 'prochaine cellule de la ligne
MsgBox s 'message affichant la somme
End Sub

Édition :

Bonjour JPN on s'est croisé

Édition 2 :

Désolé JNP je me suis melangé les pinceaux...
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Addition cellule en rouge

Bonjour à tous
Une variante :
Code:
[COLOR="DarkSlateGray"][B]Function SRouge(ParamArray r())
Dim z&, oCel As Range
   Application.Volatile
   For z = LBound(r) To UBound(r)
      For Each oCel In r(z).Cells
         If oCel.Interior.Color = vbRed Then
            If IsNumeric(oCel.Value) And Not IsEmpty(oCel) Then SRouge = SRouge + oCel.Value
         End If
      Next oCel
   Next z
   If IsEmpty(SRouge) Then SRouge = ""
End Function[/B][/COLOR]
Cette fonction accepte une sélection multiple pour argument. Par exemple, =srouge(E2;C4:E14;I7).​
ROGER2327
#4123


Samedi 7 Absolu 138 (Saint Alambic, abstracteur, SQ)
28 Fructidor An CCXVIII
2010-W37-2T12:06:20Z
 

Discussions similaires