Report de cellule et Total multicritères

[fb62840]

Bonjour à toutes et à tous,

Je fais appel à vous afin de trouver une solution par macro vba pour :

Faire la somme depuis une feuille "Ventes" dans la colonne D si la Colonne C contient "1" et si la colonne D contient "<4" et reporter après la dernière ligne de saisie sur la feuille "Synthèse"

Voir le fichier en pièce jointe.

Merci beaucoup pour votre aide

 

[pierrejean]

Re : Report de cellule et Total multicritères

Bonjour fb62840

Vois si cela te convient

 

[fb62840]

Re : Report de cellule et Total multicritères

Bonjour Pierre,

Comme toujours c'est excellent.

Puis-je me permettre de demander encore un peu d'aide.

En fait j'aimerais bien parvenir à reporter sur la feuille Synthèse :
la liste des Vendeurs qui ont comme zone la valeur "<4" ainsi que le total de leur CA

Merci beaucoup

 

[pierrejean]

Re : Report de cellule et Total multicritères

Re

Voila pour tous les vendeurs

 

[fb62840]

Re : Report de cellule et Total multicritères

Merci,

Cela fonctionne parfaitement bien par contre pour l'ajuster à mon cas réel j'ai quelques soucis

Sur une feuille "Données" j'ai un identifiant, un critère exprimé en < à quelque chose (de 1 à 6) et une valeur à cumuler
J'aimerais en une seule fois reporter sur les feuilles nommées <1, <2, <3, etc
la liste des identifiants qui respectent le critère < 1 sur la feuille <1, <2 sur la feuille <2 etc
et obtenir la somme cumulée pour chacun de ces identifiants

J'ai essayé en utilisant votre code ainsi :

tablo = Sheets("Données").Range("C2:E" & Sheets("Données").Range("G" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
 x = tablo(n, 1) 'Référence
 'Si le critère correspond à "<1" alors on ajoute à la somme existante la somme de la volée à ajouter
 If tablo(n, 2) = "<8" Then dico(x) = dico(x) + tablo(n, 3)

Next
derlin = Sheets("<1").Range("A" & Rows.Count).End(xlUp).Row + 1
'On place en colonne 1 la valeur de la Référence
Sheets("<1").Range("A" & derlin).Resize(dico.Count) = Application.Transpose(dico.keys)
'On place en colonne 2 le score total de toutes les volées pour celle ci
Sheets("<1").Range("B" & derlin).Resize(dico.Count) = Application.Transpose(dico.items)

]

J'aimerais ajouter en dessous :

tablo = Sheets("Données").Range("C2:E" & Sheets("Résultats").Range("G" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
 x = tablo(n, 1) 'Référence
 If tablo(n, 2) = "<8" Then dico(x) = dico(x) + tablo(n, 3)
Next
derlin = Sheets("<2").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("<2").Range("A" & derlin).Resize(dico.Count) = Application.Transpose(dico.keys)
'On place en colonne 2 le score total de toutes les volées pour celle ci
Sheets("<2").Range("B" & derlin).Resize(dico.Count) = Application.Transpose(dico.items)

Et ainsi de suite avec <3, <4 etc mais ça ne marche pas