Additionner cellules de couleur

Résolu/Fermé

boomer - 13 févr. 2011 à 21:59
boomer - 14 févr. 2011 à 18:36

Bonjour,

J'aimerais savoir comment modifier ma macro me permettant d'additionner les cellules de couleur
La macro:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Macro permettant de mettre en couleur deux cellules cote à cote
If Not Application.Intersect(Target, Range("A1:BW40")) Is Nothing Then
With Target
If .Interior.ColorIndex = 40 Then
.Interior.ColorIndex = xlNone
.Offset(1, 0).Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 40
.Offset(0, 1).Interior.ColorIndex = 40
End If
End With
End If

Cancel = True

End Sub

Elle selectionne le texte en 1 ere colonne et sa valeur en 2eme colonne. en faisant un double clic sur la 1 ere colonne (reference texte )
Le probleme intervient sur mon autre macro qui me calcul la somme des cellules colorées:

Sub Additionner()
Dim nbcolonne As Integer, nbligne As Integer

For nbcolonne = 4 To 17

For nbligne = 5 To 30

Cells(nbligne, nbcolonne).Select

If Selection.Interior.ColorIndex = 40 Then
totalSomme = totalSomme + ActiveCell.Value
End If
Next nbligne
Next nbcolonne

Range("K1").Value = totalSomme
'Reviens à la cellule A1
Range("A1").Select

End Sub

Elle fonctionne quand il n'y a que des valeurs chiffres colorés. Sinon elle m'indique un message d'erreur '13' avec totaSomme en jaune quand les 2 cellules (texte et sa valeur) sont en couleur.
Je pense qu'elle prends en compte le texte et non les valeurs numeriques

Peut etre y aurait il un moyen plus simple pour effectuer cette macro

J'espere ne pas avoir été trop confus

Merci

A voir également:

Additionner cellules de couleur
Excel additionner des cellules - Guide
Excel cellule couleur si condition texte - Guide
Somme si couleur - Guide
Verrouiller cellules excel - Guide
La boite a couleur - Télécharger - Divers Photo & Graphisme

4 réponses

Réponse 1 / 4

Paf
14 févr. 2011 à 00:28

bonsoir,

tu attribues une couleur à des cellules texte et des cellules chiffrées; puis tu veux additionner ces cellules colorées (texte +nombre !) !!! ça ne peux pas marcher.

Une solution possible, attribuer une autre couleur à la cellule texte, ce qui évitera de modifier la sub additionner().

Par ailleurs dans Private Sub Worksheet_BeforeDoubleClick, si la cellule n'est pas colorée tu la colores ainsi que la cellule d'à coté ; mais si elle est déjà colorée, tu supprimes cette couleur de la cellule ainsi que celle du dessous ?

A+

Réponse 2 / 4

Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 942
Modifié par Mytå le 14/02/2011 à 01:38

Salut le forum

Ta macro corrigée pour ne prendre en compte que les cellules numériques

Sub Additionner() 

  Dim Col As Integer 
  Dim Lig As Integer 
  Dim TotalSomme As Single 'Ou Currency 

For Col = 4 To 17 
  For Lig = 5 To 30 
    With Cells(Lig, Col) 
      If .Interior.ColorIndex = 40 And IsNumeric(.Value) Then 
        TotalSomme = TotalSomme + .Value 
      End If 
    End With 
  Next Lig 
Next Col 

Range("K1").Value = TotalSomme 

End Sub

Mytå

Réponse 3 / 4

Mytå Messages postés 2973 Date d'inscription mardi 20 janvier 2009 Statut Contributeur Dernière intervention 20 décembre 2016 942
14 févr. 2011 à 01:40

Re le forum

Boomer, tu as mal recopier la macro : Fil d'origine

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  

If Not Application.Intersect(Target, Range("A1:BW40")) Is Nothing Then  
With Target  
  If .Interior.ColorIndex = 40 Then  
    .Interior.ColorIndex = xlNone  
    .Offset(0, 1).Interior.ColorIndex = xlNone  
  Else  
    .Interior.ColorIndex = 40  
    .Offset(0, 1).Interior.ColorIndex = 40  
  End If  
End With  
End If  

Cancel = True  

End Sub

Réponse 4 / 4

boomer
14 févr. 2011 à 18:36

salut

myta , ta macro fonctionne parfaitement
et effectivement il y avais une inversion au niveau d'offset

Merci encore pour vos reponses , c'est sympa de me venir en aide!!!

Discussions similaires

Si couleur, alors...

sertissage des cables rj45

addition de pourcentage

comment brancher cette multitude de fils

Discussions similaires

Newsletters