Fonction : compter selon couleur (avec bornes couleurs)

zebanx · 11 Décembre 2018

Bonjour à tous,

Je cherche à compléter une fonction fournie par JB () permettant de :
- faire une somme sur un range en fonction des couleurs (ici la couleur de la cellule sur même colonne et prochaine ligne)
- en limitant le calcul par une sortie si on retrouve la même couleur que celle où est renseignée la fonction.
J'ai essayé de sortir de la boucle sur le code ci-joint mais cela ne fonctionne pas.

Comme habituellement, un fichier pour être plus clair.
Les formules en colonne "F" ne sont là que pour donner le résultat, l'objectif étant d'utiliser la fonction directement qui évitera de "borner".

Merci par avance à ceux qui seront intéressés.

Bonne apm
zebanx

VB:

Function scr(champ As Range, couleurFond As Range)
  Application.Volatile
  Dim c, temp
  temp = 0
  x = ActiveCell.Interior.ColorIndex
  For Each c In champ
    If c.Interior.ColorIndex = couleurFond.Interior.ColorIndex Then
      If IsNumeric(c.Value) Then temp = temp + c.Value
    If c.Interior.ColorIndex = x Then GoTo prochain
    End If
  Next c
prochain:
  scr = temp
End Function

BOISGONTIER · 11 Décembre 2018

Bonjour,

Je n'ai pas compris la question.

x=ActiveCell.Interior.Colorindex n'a pas de sens. Peut être à remplacer par
x= Range(Application.Caller.Address).Interior.Colorindex

A tout hasard: Somme des cellules qui ont la couleur de la cellule où est écrite la fonction

Code:

Function sommeCouleur(champ As Range)
    Application.Volatile
    couleurfond = Range(Application.Caller.Address).Interior.Color
    Ttal = 0
    For Each c In champ
     If IsNumeric(c.Value) Then
       If c.Interior.Color = couleurfond Then Ttal = Ttal + c.Value
     End If
    Next c
    sommeCouleur = Ttal
End Function

Boisgontier

zebanx · 11 Décembre 2018

Bonjour JB

Merci au préalable de prendre cette demande.

Effectivement, j'ai du mal à clarifier cette demande donc fichier complété.

Les couleurs correspondent à des niveaux de sous-totaux :

En bleu : quand on saisit la fonction SCR, la fonction additionne les valeurs des cellules en "gris" jusqu'à la prochaine cellule en "bleu"

En gris : Idem quand on saisit la fonction SCR, la fonction additionne les valeurs des cellules en "jaune" jusqu'à la prochaine cellule en "gris"

La fonction que vous avez fourni permet de travailler sur tout un range contournable par un indirect (en gros : somme(ligne +1 : "borne de fin")) qui n'aura pas à être repris.
Mais il faut qu'on puisse sortir du code à chaque fois que la même couleur de la cellule active est retrouvée.

Application.Caller.Address parait être une excellente idée mais je n'arrive pas à l'imbriquer dans la boucle principale pour sortir (ie : si la couleur est retrouvée).

J'espère avoir été plus clair.

Bonne soirée et merci par avance pour tous vos précieux commentaires.
zebanx

BOISGONTIER · 11 Décembre 2018

Voir Essai en PJ

Les fonctions ont une couleur de fond rouge

En C2: =sommecouleur(C4:C100;couleurref(A2))

Somme des cellules qui ont la couleur de reférence (A2) et s'arrêtant en C15 parce que couleur rouge

Code:

Function sommeCouleur(champ As Range, couleurfond)
    Application.Volatile
    x = Range(Application.Caller.Address).Interior.Color
    Ttal = 0
    For Each c In champ
     If IsNumeric(c.Value) Then
       If c.Interior.Color = x Then sommeCouleur = Ttal: Exit Function
       If c.Interior.Color = couleurfond Then Ttal = Ttal + c.Value
     End If
    Next c
    sommeCouleur = Ttal
End Function

Function couleurRef(cel)
  couleurRef = cel.Interior.Color
End Function

Boisgontier

zebanx · 11 Décembre 2018

Merci Jacques.

Je devrais pouvoir finaliser avec ce code.

Bonne soirée
zebanx

zebanx · 11 Décembre 2018

@jb

Ca fonctionne impeccable, merci

Un dernier fichier pour une petite "démo". Si tu copies / colles certaines zones, le calcul est refait sans avoir à changer de bornes.
Pratique quand on supprime ou rajoute des lignes en ne s'occupant que de la borne finale dès le départ (ici 100 pour les lignes ou z pour les colonnes).

@+
zebanx

Fonction : compter selon couleur (avec bornes couleurs)

zebanx

XLDnaute Accro

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

zebanx

XLDnaute Accro

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

zebanx

XLDnaute Accro

zebanx

XLDnaute Accro

Pièces jointes

Discussions similaires