Somme si couleur en VBA

Bonsoir,

Je souhaiterais effectuer la formule "somme si couleur" sur une plage A1:A10 et obtenir les totaux pour les couleurs rouges, bleues et vertes mais en VBA (avec un bouton pour les trois couleurs) car actuellement il faut rafraichir manuellement les formules pour qu'elles soient exécutées. D'autre part, je ne trouve pas le code couleur pour le vert (le code 3 pour le rouge et le code 5 pour le bleu foncé fonctionnent).

Merci pour votre aide, le fichier est en PJ.

dul

Bonsoir,

Avec Application.Volatile, le rafraichissement ne se fait pas si on modifie des couleurs, mais il se fait si des valeurs changent, ce qui déclenche un recalcul...

Je ne trouve par contre pas que déclencher un recalcul par SelectionChange soit une bonne idée.

ColorIndex était préférable avec les anciennes versions d'Excel, qui n'affichaient que les couleurs de la palette, mais les nouvelles n'ayant pas cette limitation depuis 2007, il est désormais préférable d'utiliser Color.

Et également pointer la couleur à additionner avec une cellule repère ou carrément avec la même couleur affectée à la cellule qui contient la formule, évite de s'emmêler avec des codes...

Cordialement.

Bonsoir MFerrand,

Je vous remercie pour votre aide et ai donc recherché une autre voie, avec pointage de la couleur de référence dans une cellule, ce qui a résolu le problème des codes couleurs introuvables. J'ai adapté un code prévu pour retrouver une couleur dans une ligne à mes colonnes et bien sûr additionner les chiffres concernés. Cela fonctionne très bien avec quelques lignes mais avec les 80 lignes du fichier définitif, le temps de traitement dépasse les 45 secondes, pourriez-vous m'indiquer comment simplifier/modifier mon horrible code. Merci.

Le fichier est en PJ.

Dul.

Bonsoir,

Tu dois avoir un autre problème car j'ai fait une recopie de la plage jusqu'à la ligne 404 : l'exécution s'est déroulée en 781 millisecondes, c'est déjà pas très rapide et on va tâcher d'améliorer ça, mais entre 0,8 secondes et 45 il y a tout de même quelque chose qui ne va pas.

Re,

Avec la proc. ci-dessous 62 millisecondes, soit 12 fois plus vite que tout à l'heure pour le même travail.

Sub Bouton1_QuandClic()
    Dim c As Range, cClrRef(2) As Long, cClrFont&, CmptSom(2), i%
    With ActiveSheet
        With .Range("M1:O1")
            For i = 1 To 3
                cClrRef(i - 1) = .Cells(i).Font.Color
            Next i
        End With
        For Each c In .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
            If IsNumeric(c) Then
                cClrFont = c.Font.Color
                For i = 0 To 2
                    If cClrRef(i) = cClrFont Then
                        CmptSom(i) = CmptSom(i) + c.Value: Exit For
                    End If
                Next i
            End If
        Next c
        .Range("M2:O2").Value = CmptSom
    End With
End Sub

J'ai enlevé la mesure du temps d'exécution car il me semble que Timer ne fonctionne pas sous MAC...

Les différences : pas de Select ni ActiveCell, bien sûr, on délimite la plage à parcourir et on le fait au moyen d'un boucle For Each... Next, on n'initialise pas de variable à 0 (une variable déclarée a déjà la valeur 0 si numérique ou "" si String, et Empty si Variant, Empty qui renverra 0 ou "" selon le contexte d'appel), les couleurs de référence sont prélevées dans un tableau de 3 éléments (cClrRef), on ne parcourt la plage qu'une seule fois, on prélève toujours la couleur de la cellule dans une variable (cClrFont) mais on teste les 3 couleurs en boucle, la couleur identifiée on ajoute la valeur au compteur pour la couleur (tableau CmptSom à 3 éléments dont les indices correspondent à ceux du tableau des couleurs de référence), le parcours fini on n'a plus qu'à affecter directement le tableau à la plage de destination.

A voir si rencontre des problèmes avec ça... (mais sur MAC cela risque d'être épineux...)

Cordialement.

Bonsoir, MFerrand

si MFerrand est d'accord je vous propose ceci :

Sub LouReeD()
Dim tab_comptage(2)
Dim tab_couleur(2)
Dim Ligne As Long
tab_couleur(0) = Range("M1").Font.Color
tab_couleur(1) = Range("N1").Font.Color
tab_couleur(2) = Range("O1").Font.Color
Ligne = 4
Do
    If Cells(Ligne, 1).Value = "" Then Exit Do
    For i = 0 To 2
        If Cells(Ligne, 1).Font.Color = tab_couleur(i) Then
            tab_comptage(i) = tab_comptage(i) + Cells(Ligne, 1).Value
            Exit For
        End If
    Next
    Ligne = Ligne + 1
Loop
Range("M3:O3") = tab_comptage
End Sub

En fait on test de une à trois couleur par ligne, et on fait la somme dans un tableau correspondant à la couleur "trouvée"...

Ensuite sur les cellules M3 à O3 on affiche les valeurs des trois compteurs.

C'est rapide, je viens de faire le test sur 3898 lignes, c'est "quasi" immédiat.

@ bientôt

LouReeD

Edit : Oups ! MFerrand à déjà répondu...

MFerrand, si je comprend bien le code :

le fait de définir un With avec trois colonnes et une seule ligne lorsque l'on met :

cClrRef(i - 1) = .Cells(i).Font.Color

VBA comprend qu'il doit aller vers "la droite" et non pas vers "le bas"...

Je suis bête ! En fait le CELLS sous entant les cellule de la plage du WITH !!!!

L'idée de rentrer les code couleurs par boucle... je suis passé à coté !

C'est comme l'idée de vérifier que ce soit "numérique" !

Un For Each Net est-il plus rapide qu'un Do Loop ?

sans parler du fait que dans un cas la boucle est définie... Mais oui du coup cela doit être plus rapide car pas de test de sortie !

Bravo à vous !

De mon coté je suis content d'être "tombé" sur un code similaire, le VBA commence à faire parti de moi !

@ bientôt

LouReeD

Salut LouReed !

La numérotation en utilisant Cells(i), un numéro de cellule à la place des numéros de ligne et colonne est valide, Excel utilise par défaut une numérotation par lignes : 1=A1, 2=B1... 16384=XFD1, 16385=A2... mais cela ne peut-être fiable et pratiquement utilisable que sur des plages bien délimitées et réduites, parce que sur la feuille on perdrait vite le fil, et les risques d'erreurs seraient grands, mais sur de petites plages cela peut être pratique...

Le non numérique est le seul risque d'erreur en utilisant + car la cellule vide renverra 0...

Rien à dire côté rapidité. Sur des séries répétées, les deux convergent au mini à 31 millisecondes ! (sur la même plage testée)

Je ne pense pas qu'ajouter un test IsNumeric fera beaucoup varier... la mienne a varié de 62 à 31, le contexte tant appli que windows, peut être plus favorable à certains moments ou défavorable... (là je n'avais déjà plus d'autres classeurs ouverts !)

Mais attendons, parce que même sa procédure initiale s'exécutait chez moi en moins d'une seconde, alors qu'il déclarait 45 s ! Si cela se maintient, on est forcément sur un autre type de problème que l'optimisation du code...

Bonne soirée. Tu prends des réflexes VBA+ (par rapport à Excel) si je puis dire...

Bonsoir MFerrand, Bonsoir LouReeD,

Merci beaucoup pour vos codes, vos deux propositions fonctionnent parfaitement et de façon immédiate, également dans mon fichier final (et même sur un Mac épineux). Les nombres à additionner étant issus de formules, j'avais imaginé un moment que leur présence était la cause d'un si long temps de traitement, mais il n'en était rien, la seule raison était mon bidouillage douteux.

Cordialement.

Dul

Bonne continuation.

je dirais même plus ; Bonnes continuations !

Et merci.

@ bientôt

LouReeD