XL 2016 Rechercher VBA matricules par rapport à un poste

[Jefekoi]

Bonjour à tous,

Dans la colonne A j'ai une liste de poste de travail
Dans la colonne B les matricules des personnes qui ont occupés le ou les postes

Postes​	Matricules​
Poste 1​	777
Poste 1​	777
Poste 1​	444
Poste 1​	444
Poste 2​	111
Poste 2​	111
Poste 2​	888
Poste 3​	125
Poste 3​	125
Poste 1=​	2 personnes
Poste 2=​	2 personnes
Poste 3=​	1 personne

Mon but est de récupérer et d'afficher pour chaque poste combien de personne y ont travaillé (en rouge)

Voilà 3 jours que j'essaie de trouver la solution mais pas moyen.
Et comme mon programme est largement plus grand que ça ( 5 feuilles de programmation) , je souhaite faire cette formule en VBA

Merci pour votre aide.

 

[Chris401]

Bonjour Jefekoi

Dans le fichier, code que j'avais récupéré (il n'est donc pas de moi)

 

[Jefekoi]

Magnifique, je vais essayer de l'adapter à mon programme et je reviendrais confirmer si c'est bon ce qui semble être parfait

Merci Chris

 

[mapomme]

Bonjour @Jefekoi , @Chris401 ,

Pour le fun, un méthode sans variable. Cliquer sur le bouton Hop!
Code dans module1.

 

[Jefekoi]

Re ,
Magnifique Chris , la seul chose que j'ai modifié c'est si il ne trouve pas de matricule il passe son chemin

If Dico2.Count <> 0 Then
    x = x + 1
    TabFin(x, 1) = clé
    TabFin(x, 2) = Dico2.Count
End If

Merci pour ton aide qui me soulage, je commençais à désespérer

Bon week-end

MaPomme je viens de voir ton fichier Superbe je suis super content de votre aide , du coup je ne sais lequel prendre

 

[mapomme]

du coup je ne sais lequel prendre

Il faut prendre le fichier de @Chris401 parce que :

• c'est le premier qui a répondu
• en général (et sauf dans de très très rares cas) en cas de données nombreuses, l'emploi d'un dictionary est ce qu'il y a plus rapide
• vous avez déjà modifié le code de @Chris401 pour inclure le cas "pas de matricule". Ce cas n'a pas été pris en compte dans ma version.
• vous utilisez un PC sous windows (la bibliothèque mettant à disposition l'objet "dictionary" n'est pas disponible dans les systèmes d'exploitation de chez "la pomme" ou en américain "APPLE")

 

[Jefekoi]

Merci maPomme,
Chris : Je suis en train de l'adapter pour mon programme , j'aimerais récupérer aussi le matricule je fais comment ?

Je veux dire au moins un matricule de manière à mettre dans la cellule un truc du genre
777(2)
Cela indique qu'il y a un matricule mais un total de 2 pour le poste 1

 

[Chris401]

Pour le coup, c'est @mapomme le spécialiste du dictionary ; il m'a pondu un code hier pour un fichier perso qui est tout simplement parfait.

J'essaye quand même.

 

[Jefekoi]

lol je suis perdu là entre vous deux

 

[Chris401]

Bon, je n'y arrive pas.
J'attends de voir la réponse de @mapomme

 

[mapomme]

Je veux dire au moins un matricule de manière à mettre dans la cellule un truc du genre
777(2)

Re,

Sans un tableau exemple, difficile de savoir précisément ce que vous désirez.
Pour ce que j'en ai compris, un TCD doit être suffisant.

Le TCD est sur la feuille "Matricule par poste". Il s'appelle "TCDMatPoste".
Une ligne de code dans le module associé à cette feuille permet d'actualiser le TCD si la source change.

 

[Chris401]

Re
Si on passe par un TCD, utiliser le "Total Distinct" pour ne pas compter les doublons.

J'aimerai quand même savoir(pour ma formation personnelle) comment récupérer tous les matricules dans la même cellule que les qtés - J'ai essayé avec JOIN mais je n'ai pas réussi.

 

[Jefekoi]

re,

Merci à vous deux pour votre participationS
C'est assez dur de vous envoyer un fichier d'exemple, la manière qu'il a été construit est strictement confidentiel , c'est pour un contrôle d'une ligne de production, avec des résultats informatisé (xlsx) , je récupère les données et j'en fait un visu avec chaque poste , nombre de bon et mauvais résultat et avec matricule de la ou les personnes)
Je suis Contrôleur qualité

 

[fanch55]

Salut à tous,
Pourquoi un TCD ?
La solution initiale de @mapomme est correcte, il suffit de rajouter une dimension au dico avec une forrmule de recherche ad hoc .

Sub ComptePostes()
Dim Dico, Dico2, i As Long, TabIni, TabFin, x As Integer, LD As Integer
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

x = 0
Application.ScreenUpdating = False
With Worksheets("Feuil1")
TabIni = .Range("A2:B" & .Range("B" & Rows.Count).End(xlUp).Row)

For i = LBound(TabIni) To UBound(TabIni)
    Dico(TabIni(i, 1)) = "" '
Next
ReDim TabFin(1 To Dico.Count, 1 To 3)
For Each clé In Dico.keys
    For i = LBound(TabIni) To UBound(TabIni)
        If TabIni(i, 1) = clé Then Dico2(TabIni(i, 2)) = ""
    Next
    x = x + 1
    TabFin(x, 1) = clé
    TabFin(x, 2) = Dico2.Count
    TabFin(x, 3) = "=VLOOKUP(Résultat!RC[-2],Feuil1!RC[-2]:R[8]C[-1],2,FALSE)"
    Dico2.RemoveAll
Next
End With

With Sheets("Résultat")
    LD = 2
    .Select
    .Range("A2:B1000").ClearContents
    .Range("A" & LD).Resize(UBound(TabFin, 1), UBound(TabFin, 2)) = TabFin
End With
Application.ScreenUpdating = True
End Sub

 

[Jefekoi]

Merci effectivement une RECHERCHEV plus facile enfin pour moi
Merci je l'ai adapté à mon programme