2 sommes

[JJ]

Bonjour à tous,
J'ai une macro qui fonctionne et qui a deplacé des lignes en bas de tableau avec la condition d'avoir une cellule rouge (Font ColorIndex=3)
Je voudrais rajouter qques lignes de VBA pour calculer la somme de 2 colonnes en fonction de la couleur.
Ex: je mets en format ligne mais c'est 2 colonnes:
Col A: 10 20 20 30 40
Col B: 20 30 10 20 30
Ces 2 colonnes sont donc en police moire sauf par ex les 2 dernières cellules de la col A (30 et 40 ici) qui sont rouges
Je voudrais que la macro fasse la somme de ces cellules rouges en A mais aussi en B si la cellule en face en A est rouge (ici 20 et 30 en col B)
ces 2 sommes seraient reportées par ex en cellules A1 et A2
Pouvez vous m'aider
Merci
JJ

 

[pierrejean]

bonjour JJ

peux-tu faire le petit effort de mettre ton exemple dans un fichier excel S.T.P

 

[JJ]

Bonjour PierreJean

Je fais une précisison car je me suis fait 'engue...' par Gérard Dezamis (coup de gueule , voir sa réponse sujet: tri suite du 11/2/06 et ma réponse sur les 2 sites (Cathy astuces).)
C'est chose faite!

Concernant cette macro elle est résolue. (En fait c'est la somme des cellules (et celles adjacentes) que tu m'avais aidé, par une macro, à déplacer en bas de tableau.

La macro m'a été proposé et je te la livre telle quelle (échange de bons procédés non?)
Bonne soirée
JJ
'
Ici, j'ai utilisé le fond de la cellule. Si tu veux mettre les formules en A1 et A2, je suppose donc que tes données sont en A3:B7, il suffit alors de placer en A1 la formule suivante :
=CompterColor(A3:A7)
et en A2 , la formule
=CompterColorACote(A3:A7)


Function CompterColor(Plage)
Dim c As Range
For Each c In Plage
If c.Interior.ColorIndex = 3 Then
CompterColor = CompterColor + c
End If
Next
End Function

Function CompterColorACote(Plage)
Dim c As Range
For Each c In Plage
If c.Interior.ColorIndex = 3 Then
CompterColorACote = CompterColorACote + c.Offset(0, 1)
End If
Next
End Function

Comme les changements de couleurs ne sont pas interprétés comme des modifications, il faut déplacer le curseur pour provoquer le recalcul de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub
'