Fonction VBA somme avec critere couleur et critere autre

Bonsoir à tous,

Ceci est mon premier post sur le forum et tres certainement pas le dernier; quelques mots de présentation, je suis juste retraité et m'intéresse beaucoup à excel et notamment aux fonctions personnalisées en VBA. Je suis tout débutant et apprends en m'inspirant d'exemples que je trouve sur le forum.

Mon probleme: je souhaite additionner les cellules d'une plage en fonction d'un critère couleur du fond des cellules et en fonction d'un critere autre (qui dans mon cas est une année). J'ai essayé de créer une fonction SommeSiCouleurCritere, a partir de l'exemple SommeSiCouleur, en y ajoutant 2 objets Range, la plage de critère des données et la cellule de critère. Cela donne SommeSiCouleurCritère(PlageSomme;couleur;PlageCritère;critère). Cela marche lorsque la Plage Critère ne contient qu'une valeur (ce qui n'est pas le but !) et ne marche pas des qu'il y a plus de valeurs. Je joins un exemple avec les test que j'ai réalisés, les fonctions creees et adaptées, en esperant que vous pourrez gentiment m'aider à progresser en VBA !

D'avance merci

gilles

Bonjour,

Finalement à force de tests, j'ai trouve un code qui fonctionne; si cela peut rendre service, le voici:

Function SommeSiCouleurCritere(PlageSomme As Range, Couleur As Range, PlageCritere As Range, Critere As Range) As Variant

'*********************************************************************************

' Effectuer la somme des cellules en couleur avec un critere supplementaire *

'*********************************************************************************

Dim Cel As Range

Dim Som As Double

Application.Volatile True

If Couleur.Cells.Count > 1 Then

SommeSiCouleurCritere = CVErr(xlErrValue)

Exit Function

End If

For Each Cel In PlageSomme

If Cel.Interior.ColorIndex = Couleur.Interior.ColorIndex And PlageCritere(Cel.Row - (PlageCritere.Row - 1), 1) = Critere Then Som = Som + Cel

Next

SommeSiCouleurCritere = Som

Application.Calculate

End Function

Cela fonctionne bien mais est assez lent surtout pour les grandes plages de données (> 10 000 lignes).

Alors si quelqu'un a une idée comment optimiser le code et accélérer la fonction je suis preneur !

A bientôt

gilles

Salut Gilles,

Pensionné, veinard!

Si tu pouvais envoyer ton fichier de travail (couleurs et critère année) que nous puissions comprendre ce que tu veux faire, nous pourrions mieux te guider!

Bienvenue en VBA!

A+

Bonjour,

Un peu brouillon ton fichier... !

Tu te plains de la lenteur, mais tu places :

Application.Calculate

dans une fonction !

Un peu de logique !

La fonction s'exécute lorsque l'application calcule. Lorsqu'elle ne calcule pas, elle ne s'exécute pas.

Donc lorsque le calcul est en cours tu demandes de calculer, soit de multiplier les calculs !...

Bonjour à tous et merci pour vos reponses et remarques; en effet l'instruction Application.Calculate n'apporte rien; j'ai teste en la supprimant et en ajoutant un timer() à l'entrée et a la sortie, malheureusement je ne vois pas de difference (l'execution est toujours de l'ordre de 0.30s par formule). Peut etre en passant par un tableau, mais la j'ai besoin de votre aide car je ne sais pas les utiliser. J'ai lu la formation sur le forum mais ... ce n'est pas si simple!

Encore merci

gilles

J'oubliais, j'ai aussi essaye un calcul matriciel avec somme(si... et la fonction ColorCell(), ce qui devrait etre le plus rapide, mais la, le resultat est toujours 0 et je ne comprends pas pourquoi, sauf si la fonction ColorCell() ne retourne pas les bonnes valeurs.

Pour info voici la formule {=SOMME(SI(ColorCell($D$5:$D$11)=ColorCell($D$15);SI($A$5:$A$11=$F$15;$D$5:$D$11;FAUX);FAUX))}

Essaie plutôt :

Function ColorPlage(Cible As Range)
    Dim clr(), n%, k%, i%, j%
    Application.Volatile True
    With Cible
        n = .Rows.Count: k = .Columns.Count
        If n = 1 Or k = 1 Then
            ReDim clr(1 To n, 1 To k)
            For i = 1 To n
                For j = 1 To k
                    clr(i, j) = .Cells(i, j).Interior.Color
                Next j
            Next i
            ColorPlage = clr
        End If
    End With
End Function

=SOMME(SI(ColorPlage($D$5:$D$11)=ColorPlage($D$15);SI($A$5:$A$11=$F$15;$D$5:$D$11;0);0))

Cordialement.

Excellent ! Merci beaucoup. Avec la formule matricielle, le temps gagné est d'environ 4 secondes pour 165 formules qui examinent un tableau de 3000 lignes, c'est déjà tres bien.

Une idée pourquoi cela ne fonctionne pas avec la formule ColorCell() ?

Gilles

Parce que ColorCell ne renvoie pas une matrice...