XL 2016 Pb formule addition doublons + concaténation

[MichVinum]

Bonjour à tous,

J'ai besoin d'un sérieux coup de main sur une formule qui me pose pb:

A partir de la colonne B où il y a plusieurs semaines pour plusieurs valeurs je souhaite en déduire 1 semaine pour 1 valeur. Cela veut dire :

Pour l'exemple de la Week 3 (B7:B9) dans le tableau 1, nous avons 3 personnes qui ont prospecté 1 personne chacune.

Je souhaite obtenir dans le tableau 2 pour une semaine donnée (ex. Week 3) une concaténation des VRPs, l'addition des prospects pour une semaine donnée, ainsi que le cumul des prospects. Remarquez qu'il existe des cellules vides dans la colonne du Tableau 1 et que je souhaiterais que les valeurs uniques se suivent sans cellules vides dans le Tableau 2.......

Merci beaucoup pour votre aide précieuse !!

Valentin.

 

[djidji59430]

Bonjour,

c'est exactement ce que tu obtiendras avec un TCD !

Crdlmt

 

[job75]

Bonjour MichVinum, bienvenue sur XLD, salut djidji59430,

J'ai besoin d'un sérieux coup de main

Il aurait été sérieux de joindre le fichier Excel (anonymisé, sans données confidentielles).

Mais bon, placez cette macro dans un module standard (Alt+F11) et exécutez-la :

Sub Regroupe()
Dim dest As Range, tablo, d1 As Object, d2 As Object, i&, x$
Set dest = [G3] '1ère cellule des résultats, à adapter
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
tablo = Range("B3:D" & Range("B" & Rows.Count).End(xlUp).Row + 2) 'matrice, plus rapide
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
'---RAZ---
dest.Resize(Rows.Count - dest.Row + 1, 4).ClearContents
dest.Resize(Rows.Count - dest.Row + 1, 4).Borders.LineStyle = xlNone
'---remplissage des Dictionary---
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    If x <> "" Then
        d1(x) = d1(x) & IIf(d1.exists(x), ", ", "") & tablo(i, 2)
        d2(x) = d2(x) + tablo(i, 3)
    End If
Next
If d1.Count = 0 Then Exit Sub
'---restitution---
dest.Resize(d1.Count) = Application.Transpose(d1.keys)
dest(1, 2).Resize(d1.Count) = Application.Transpose(d1.items)
dest(1, 3).Resize(d1.Count) = Application.Transpose(d2.items)
dest(1, 4).Resize(d1.Count) = "=N(R[-1]C)+RC[-1]" 'cumul
dest(1, 4).Resize(d1.Count) = dest(1, 4).Resize(d1.Count).Value 'supprime les formules
dest.Resize(d1.Count, 4).Borders.Weight = xlThin 'bordurs
dest.Resize(, 4).EntireColumn.AutoFit 'ajustement largeurs
End Sub

Elle est très rapide même sur un très grand tableau.

A+

 

[chris]

Bonjour à tous

Multipost...