XL 2016 Rechercher VBA matricules par rapport à un poste

Jefekoi

XLDnaute Junior
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.
 

Jefekoi

XLDnaute Junior
Re ,
Magnifique Chris , la seul chose que j'ai modifié c'est si il ne trouve pas de matricule il passe son chemin :)
VB:
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

XLDnaute Barbatruc
Supporter XLD
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")
:)
 
Dernière édition:

Jefekoi

XLDnaute Junior
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
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • Jefekoi- occurence matricule par poste- v1.xlsm
    26.9 KB · Affichages: 9

Chris401

XLDnaute Accro
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.
 

Pièces jointes

  • Copie de Jefekoi- occurence matricule par poste- v1.xlsm
    92.9 KB · Affichages: 6

Jefekoi

XLDnaute Junior
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

XLDnaute Barbatruc
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 .
VB:
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
 

Discussions similaires

Réponses
6
Affichages
684