Compter avec plusieurs conditions dont couleur de fond

Bonjour,

Je vous explique, je dois mettre en place un indicateur qui va identifier pour chaque client (en PJ je les ai appelé A, B, C, etc...) le nombre de produits non conformes. Comme les valeurs de conformité sont différentes pour chacun, les résultats ont des couleurs, donc : vert (colorindex 4) pour coforme, orange (colorindex 44) pour passable, et non-conforme (colorindex 3) en rouge.

La subtilité, c'est que ma plage de données est modulable en taille, sur ce fichier test j'ai une dizaine de ligne mais en pratique je peux aller jusqu'à des milliers de lignes...Mes range ne sont donc de base pas fixe.

Sur un autre fichier avec des valeurs fixes pour les résultats (par exmple 1=non-conforme), j'avais utilisé une fonction COUNTIFS pour avoir plusieurs conditions, et déclaré en variables les plages et conditions à reconnaître (qui étais des String ou Integer).

Ici, je veux compter selon le client en plage client et s'il a un résultat non-conforme donc à fond rouge dans la plage résultat. J'avais donc déclaré la variable de couleur de fond en Variant, mais problème : il n'a jamais voulu me prendre en compte cette condition en COUNTIFS.

J'avais testé au préalable l'attribution de variable couleur avec un test de type : si la couleur de fond est verte, noter OK dans la cellule à côté, sinon noter "NO". Le test était fonctionnel et pour moi, la variable aussi. Donc je ne comprend pas bien pourquoi ça n'est pas pris en compte en COUNTIFS...

Deuxième essai : j'ai récupéré une function qui permet de compter la couleur indiquée. je pensais l'intégrer dans la formule VBA COUNTIFS, mais idem ça ne fonctionne pas...Je pense que quelque chose m'échappe mais je ne vois pas quoi.

Quelqu'un aurait-il une idée pour compter dans ma plage non fixe, en fonction de la couleur de fond et d'un autre paramètre ?

Je vous ai remis le fichier en pièce jointe, avec les deux essais de méthode.

Merci d'avance, déjà à qui voudra bien lire et à qui aura une idée sur la question. J'espère avoir été claire dans mon explication.

bonsoir,

un essai par fonction personnalisée :

Function NB_Color(Plage As Range, Couleur As Range, Qui As Range) As Long
'Compter le nombre de cellules d'une couleur donnée dans une plage donnée
'Plage: plage de cellules à inspecter
'Couleur: cellule référence de couleurvaleur de la couleur cherchée
'Qui : Produit pour lequel on veut compter
Dim C As Range, MaCouleur As Byte, Nb As Integer
Application.Volatile

MaCouleur = Couleur.Interior.ColorIndex

For Each C In Plage
    If C.Interior.ColorIndex = MaCouleur And Not IsEmpty(C) Then
        If C.Offset(, -1).Value = Qui.Value Then Nb = Nb + 1
    End If
Next C
NB_Color = Nb
End Function

et en B2 : =NB_Color($E$2:$E$17;$G$4;A2)

à tirer vers le bas

A+

Bonjour,

Merci pour la réponse ! Effectivement c'est parfait, il manquait un petit détail dans la function en fait autant pour moi .

Du coup ça m'amène à deux questions, car je n'ai jamais trop utilisé de function encore : peut-on mettre ça dans une macro avec boucle pour automatiser le calcul sur une plage à taille variable (je vais essayer de mon côté, plus tard cette après-midi je pense) ?

Et autre question : est-ce possible d'aller faire ce calcul ou cette boucle si faisable à partir d'informations d'une autre feuilles ? (pareil je vais un peu creuser de mon côté).

Sinon la réponse est parfaite, mais il me reste à perfectionner la praticité de la chose on va dire.

Merci encore !

à la première question: oui, mais il faut adapter le code

à la deuxième : oui

Bon creusement

Bon déjà c'est rassurant de savoir que c'est possible ! Merci pour la confirmation.

Je vais creuser, mais déjà je vais aller me revoir le cours sur les boucles

Je posterai ma solution si je la trouve ou mon appel de détresse si besoin

Très bien, alors j'ai effectivement pu adapter pour une plage variable. N'ayant pas trouvé comment bidouiller la function, j'ai recréé un sub qui appelle la function :

Sub testsurmêmefeuille()

Dim cli1 As Range
Dim cli2 As Range
Dim cli3 As Range
Dim cli4 As Range
Dim cli5 As Range
Dim plagnc As Range
Dim plagcol As Range
Set cli1 = Range("a2")
Set cli2 = Range("a3")
Set cli3 = Range("a4")
Set cli4 = Range("a5")
Set cli5 = Range("a6")
Set plagnc = Range("e2:e" & Range("e2").End(xlDown).Row)
Set plagcol = Range("g4")

Range("b2") = NB_Color(plagnc, plagcol, cli1)
Range("b3") = NB_Color(plagnc, plagcol, cli2)
Range("b4") = NB_Color(plagnc, plagcol, cli3)
Range("b5") = NB_Color(plagnc, plagcol, cli4)
Range("b6") = NB_Color(plagnc, plagcol, cli5)

End Sub

Je l'ai associé à un bouton, et ça marche impeccablement bien. Bon il y avait peut être plus simple, ou plus direct mais euh je n'ai pas trouvé. Par contre j'ai testé d'appeler depuis une autre feuille. J'ai joint le fichier modifié en pièce jointe. EN gros sur la feuille 1, j'ai la liste des clients de A à E, le code couleur et je veux renvoyer le résultat de la liste disponible en Feuille2.

J'ai essayé ce code :

Sub testsurfeuillediff()

Dim cli1 As Range
Dim cli2 As Range
Dim cli3 As Range
Dim cli4 As Range
Dim cli5 As Range
Dim plagnc As Range
Dim plagcol As Range
Set cli1 = Worksheets("Feuil1").Range("a2")
Set cli2 = Worksheets("Feuil1").Range("a3")
Set cli3 = Worksheets("Feuil1").Range("a4")
Set cli4 = Worksheets("Feuil1").Range("a5")
Set cli5 = Worksheets("Feuil1").Range("a6")
Set plagnc = Worksheets("Feuil2").Range("e2:e" & Range("e2").End(xlDown).Row)
Set plagcol = Worksheets("Feuil1").Range("g4")

Worksheets("Feuil1").Range("b2") = NB_Color(plagnc, plagcol, cli1)
Worksheets("Feuil1").Range("b3") = NB_Color(plagnc, plagcol, cli2)
Worksheets("Feuil1").Range("b4") = NB_Color(plagnc, plagcol, cli3)
Worksheets("Feuil1").Range("b5") = NB_Color(plagnc, plagcol, cli4)
Worksheets("Feuil1").Range("b6") = NB_Color(plagnc, plagcol, cli5)

End Sub

Et ça me met un message d'erreur : "Erreur d'exécution '6' : dépassement de capacité."

Faut-il utiliser des select ? Car à par ça je ne vois pas...

Merci d'avance !

Alors après avoir posté, je me rends compte que dans la deuxième macro testsurfeuillediff(), j'ai demandé de vérifier la couleur en g4 de la feuille 1, alors que c'était en d4....

Après avoir modifié ce léger hum détail, j'ai les résultats suivants :

A = 1

B = 1

C = 0

D = 0

E = 0

Alors que je devrais avoir :

A = 1

B = 2

C = 1

D = 1

E = 3

Bon ça marche mais à moitié, je progresse...mais si quelqu'un a une idée, je suis toujours preneuse .

LoloXBlade a écrit :

Et ça me met un message d'erreur : "Erreur d'exécution '6' : dépassement de capacité."

Bonjour,

"Dépassement de capacité", c'est comme quand tu essaies de faire rentrer 15 personnes dans une smart !

Tu as sans doute une variable dans laquelle tu essaies de mettre une information plus grande que ce qu'elle peut contenir...

Par exemple : une variable de type "Byte" peut contenir un nombre entier de 0 à 255, de type "Integer", un entier de -32768 à +32767 et de type "Long", un entier de -2147483648 à 2147483647. Il faut donc choisir le bon type, sachant qu'en terme de ressources mémoire, Byte est moins gourmand qu'Integer, lui même plus "léger" que Long.

PS : les instructions "Select", c'est le mal ! A proscrire dès que tu le peux...

ça ne fonctionnait pas car la plage de recherche n'était pas bien définie

Set plagnc = Worksheets("Feuil2").Range("e2:e" & Range("e2").End(xlDown).Row)

le premier range est bien lié à une feuille mais pas le second. le second allait donc chercher une valeur sur la feuille courante (en l'occurrence Feuil1)

une proposition de correction:

Sub testsurfeuillediff()

Dim plagnc As Range
Dim MaCouleur As Byte, C As Range, i As Long, Nb As Integer

With Worksheets("Feuil2")
Set plagnc = .Range("E2:E" & .Range("E" & Rows.Count).End(xlUp).Row)
End With
MaCouleur = Worksheets("Feuil1").Range("D4").Interior.ColorIndex
'on aurait pu mettre directement MaCouleur=3 pour rouge, 4 jaune...

With Worksheets("Feuil1")
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row 'on va boucler sur toutes les cellules de A
    Nb = 0
    For Each C In plagnc
        If C.Interior.ColorIndex = MaCouleur Then
                If C.Offset(, -1).Value = .Cells(i, 1).Value Then Nb = Nb + 1
        End If
    Next
    .Cells(i, 2) = Nb
Next
End With

End Sub

A+

Mais décidément quelle étourdie je fais, je pensais avoir vu tous les range ...

Merci à vous deux ! Effectivement maintenant ça marche.

Au passage je trouve ton code plus "simple" si je puis dire ça me donnera des idées pour des utilisations futures.

Et du coup Pedro22 mon dépassement de variable venait de mon erreur d'attribution entre la d4 et la g4...Effectivement là je lui en demandais beaucoup à la smart !

Je vais valider le sujet, pour moi c'est tout bon.