XL 2019 Liste déroulante

chinel

XLDnaute Impliqué
Bonjour tout le monde, je cherche à faire une liste déroulante dans ma feuille (Comptage) avec tous les prénoms des gens de la feuille (Personnel) mais sachant qu'une liste déroulante ne peut se faire que, en ligne ou en colonne, je ne sais pas comment faire. Merci de votre aide !
 

Pièces jointes

  • Planning d'équipe Melvin.xlsm
    53.6 KB · Affichages: 15

chinel

XLDnaute Impliqué
@chinel : apparemment, tu as ouvert une discussion que tu lis de travers ou en oblique.
Je t'invite à relire toute la discussion et prendre des notes pour synthétiser tout ce qui t'a été dis.
La capture d'écran est la finalité que l'on peut obtenir de différences manières.
Le souci réside surtout dans tes données (feuille personnel). Est-ce que André et Andre ne font qu'un, c'est à dire désigne la même personne? Si oui, donc les résultats seront faux.
Je pense que je vais supprimer une de deux feuilles (Personnel ou Comptage) et n'en faire qu'une. Copier les prénoms venant de la feuille Planning et les mettre à la suite de l'autre dans une colonne. Je test et je vous ferai un retour.🤞
 

cp4

XLDnaute Barbatruc
Je pense que je vais supprimer une de deux feuilles (Personnel ou Comptage) et n'en faire qu'une. Copier les prénoms venant de la feuille Planning et les mettre à la suite de l'autre dans une colonne. Je test et je vous ferai un retour.🤞
Bonjour,
@chinel : Tu nous as dit que tu avais une vie après le boulot. Nous aussi.
Comme vous ramez (toi et ton chef) à l'envers. J'ai trouvé un moment pour une solution. Tu trouveras dans 2 codes le lien du site de feu Jacques Boisgontier ;) (il n'est plus là mais à laisser une bibliothèque pour nous aider). J'espère qu'il vous sera très utile.
/!\ il faut adapter le nom de la feuille qui recevra le résultat.
VB:
Option Explicit
Dim d As Object
Sub RecapMachine()
   Dim Fp As Worksheet, Fc As Worksheet, Tb(), dl As Integer, i As Integer, j As Integer
   Dim plage As Range, C As Range

   Set Fp = ThisWorkbook.Worksheets("personnel")
   Set Fc = ThisWorkbook.Worksheets("feuil2")   'feuille à adapter

   Set d = CreateObject("scripting.dictionary")

   With Fp
      dl = .Range("A" & Rows.Count).End(xlUp).Row
      Tb = .Range("B2:AE" & dl).Value
   End With
   'on récupère tous les noms sans doublons en utilisant le dictionnaire 'd'
   'pour dimensionner le Tableau Tt avec lequel on va récuperer le nombre de fois agent sur même machine
   For i = LBound(Tb) To UBound(Tb)
      For j = LBound(Tb, 2) To UBound(Tb, 2)
         If Tb(i, j) <> "" Then d(Tb(i, j)) = ""
      Next j
   Next i

   DicoTri d   'on tri pour avoir les noms triés

   ReDim Tt(1 To d.Count - 1, 1 To 31)   ' on dimensionne le tableau
   'on alimente entete
   For i = 2 To 31
      Tt(1, i) = Fp.Cells(1, i)
   Next i
   ' on alimente les noms
   For i = 2 To d.Count - 1
      Tt(i, 1) = d.keys()(i)
   Next i
   ' on comptabilise les occurences des noms
   For j = 2 To UBound(Tt, 2)
      For i = 2 To UBound(Tt)
         Set plage = Fp.Range(Fp.Cells(2, j), Fp.Cells(dl, j))
         If Application.CountA(plage) = 0 Then
            Exit For
         Else
            For Each C In plage
               If C.Value = Tt(i, 1) Then Tt(i, j) = Tt(i, j) + 1
            Next C
         End If
      Next i
   Next j
   'report sur la feuille
   With Fc
      .Cells.Clear
      .Range("A1").Resize(UBound(Tt), UBound(Tt, 2)) = Tt
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      .Rows(1).Orientation = xlVertical
      .Columns("A:AE").EntireColumn.AutoFit
      With .Range("A1").CurrentRegion.Offset(1, 1)
         .HorizontalAlignment = xlCenter
         .Font.Bold = True
      End With
   End With
   Set plage = Nothing
   Set d = Nothing
   Set Fc = Nothing: Set Fp = Nothing
End Sub
Sub DicoTri(dico)   'Source du code http://boisgontierj.free.fr/
   Dim i As Integer, Tbl
   Tbl = d.keys                           ' Transfert Dictionnaire dans Array
   Tri Tbl, LBound(Tbl), UBound(Tbl)   ' Tri Array
   d.RemoveAll                           ' Création du dictionnaire
   For i = LBound(Tbl) To UBound(Tbl)
      d(Tbl(i)) = ""
   Next i
End Sub
Sub Tri(a, gauc, droi)          ' Quick sort 'Source du code http://boisgontierj.free.fr/
   Dim ref As String, g As Integer, d As Integer, temp
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref: g = g + 1: Loop
      Do While ref < a(d): d = d - 1: Loop
      If g <= d Then
         temp = a(g): a(g) = a(d): a(d) = temp
         g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub
 

chinel

XLDnaute Impliqué
Bonjour,
@chinel : Tu nous as dit que tu avais une vie après le boulot. Nous aussi.
Comme vous ramez (toi et ton chef) à l'envers. J'ai trouvé un moment pour une solution. Tu trouveras dans 2 codes le lien du site de feu Jacques Boisgontier ;) (il n'est plus là mais à laisser une bibliothèque pour nous aider). J'espère qu'il vous sera très utile.
/!\ il faut adapter le nom de la feuille qui recevra le résultat.
VB:
Option Explicit
Dim d As Object
Sub RecapMachine()
   Dim Fp As Worksheet, Fc As Worksheet, Tb(), dl As Integer, i As Integer, j As Integer
   Dim plage As Range, C As Range

   Set Fp = ThisWorkbook.Worksheets("personnel")
   Set Fc = ThisWorkbook.Worksheets("feuil2")   'feuille à adapter

   Set d = CreateObject("scripting.dictionary")

   With Fp
      dl = .Range("A" & Rows.Count).End(xlUp).Row
      Tb = .Range("B2:AE" & dl).Value
   End With
   'on récupère tous les noms sans doublons en utilisant le dictionnaire 'd'
   'pour dimensionner le Tableau Tt avec lequel on va récuperer le nombre de fois agent sur même machine
   For i = LBound(Tb) To UBound(Tb)
      For j = LBound(Tb, 2) To UBound(Tb, 2)
         If Tb(i, j) <> "" Then d(Tb(i, j)) = ""
      Next j
   Next i

   DicoTri d   'on tri pour avoir les noms triés

   ReDim Tt(1 To d.Count - 1, 1 To 31)   ' on dimensionne le tableau
   'on alimente entete
   For i = 2 To 31
      Tt(1, i) = Fp.Cells(1, i)
   Next i
   ' on alimente les noms
   For i = 2 To d.Count - 1
      Tt(i, 1) = d.keys()(i)
   Next i
   ' on comptabilise les occurences des noms
   For j = 2 To UBound(Tt, 2)
      For i = 2 To UBound(Tt)
         Set plage = Fp.Range(Fp.Cells(2, j), Fp.Cells(dl, j))
         If Application.CountA(plage) = 0 Then
            Exit For
         Else
            For Each C In plage
               If C.Value = Tt(i, 1) Then Tt(i, j) = Tt(i, j) + 1
            Next C
         End If
      Next i
   Next j
   'report sur la feuille
   With Fc
      .Cells.Clear
      .Range("A1").Resize(UBound(Tt), UBound(Tt, 2)) = Tt
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      .Rows(1).Orientation = xlVertical
      .Columns("A:AE").EntireColumn.AutoFit
      With .Range("A1").CurrentRegion.Offset(1, 1)
         .HorizontalAlignment = xlCenter
         .Font.Bold = True
      End With
   End With
   Set plage = Nothing
   Set d = Nothing
   Set Fc = Nothing: Set Fp = Nothing
End Sub
Sub DicoTri(dico)   'Source du code http://boisgontierj.free.fr/
   Dim i As Integer, Tbl
   Tbl = d.keys                           ' Transfert Dictionnaire dans Array
   Tri Tbl, LBound(Tbl), UBound(Tbl)   ' Tri Array
   d.RemoveAll                           ' Création du dictionnaire
   For i = LBound(Tbl) To UBound(Tbl)
      d(Tbl(i)) = ""
   Next i
End Sub
Sub Tri(a, gauc, droi)          ' Quick sort 'Source du code http://boisgontierj.free.fr/
   Dim ref As String, g As Integer, d As Integer, temp
   ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
      Do While a(g) < ref: g = g + 1: Loop
      Do While ref < a(d): d = d - 1: Loop
      If g <= d Then
         temp = a(g): a(g) = a(d): a(d) = temp
         g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub
Merci pour ton soutien, mais là, je suis perdu..🙃 j'ai ajouter une feuille "Feuil2" pour ne pas modifier ton code et dans ma feuille "Planning" j'ai ajouter un bouton qui active ta macro, mais j'ai un bug 🤔
 

Pièces jointes

  • erreur2.png
    erreur2.png
    68 KB · Affichages: 16

cp4

XLDnaute Barbatruc
Tt() n'est pas déclaré, et avec Option Explicit ben... ça coince.
Salut TooFatBoy;), chez-moi aucun plantage avec démo à l'appui.
Initialement, j'allais faire un Redim Preserve Tt() d'où le ReDim Tt(1 To d.Count - 1, 1 To 31).
Sinon, le code aurait planté car j'ai déjà rencontré ce problème. @job75 ;) m'a donné la solution (ICI).
Mais suite à la lecture d'un code de JB, je suis ravisé pour faire un peu plus simple.
J'ai donc juste ôter le Preserve et ça fonctionne sur ma bécane (win7 6 bits, Excel 2010 32 bits).
Chinel.gif

Voilà, pas de plantage alors qu'il n'y a pas Dim Tt().
 

cp4

XLDnaute Barbatruc
De quoi parles tu ? Je n'ai pas compris le sens de ta phrase ? 🤔 Ton fichier fonctionne bien, merci pour ton boulot ! Je ne suis pas aussi fort que toi en VBA alors certaines explications m'échappent, désolé
Je fais allusion à l'orthographe de la nouvelle feuille que tu as ajouté. Il semble que tu ajoutes des espaces partout. Est-ce que tu utilises tous tes doigts pour taper rapidement au clavier? Si c'est le cas, tu es excès de vitesse par conséquent tu ne contrôles pas exactement ce que tu tapes.
 

chinel

XLDnaute Impliqué
Je fais allusion à l'orthographe de la nouvelle feuille que tu as ajouté. Il semble que tu ajoutes des espaces partout. Est-ce que tu utilises tous tes doigts pour taper rapidement au clavier? Si c'est le cas, tu es excès de vitesse par conséquent tu ne contrôles pas exactement ce que tu tapes.
Je tape toujours avec mes 10 doigts depuis des années et ça, 48 heures par semaine 😁 (désolé pour la faute de frappe).
 

TooFatBoy

XLDnaute Barbatruc
Salut TooFatBoy;), chez-moi aucun plantage avec démo à l'appui.
Initialement, j'allais faire un Redim Preserve Tt() d'où le ReDim Tt(1 To d.Count - 1, 1 To 31).
Sinon, le code aurait planté car j'ai déjà rencontré ce problème. @job75 ;) m'a donné la solution (ICI).
Mais suite à la lecture d'un code de JB, je suis ravisé pour faire un peu plus simple.
J'ai donc juste ôter le Preserve et ça fonctionne sur ma bécane (win7 6 bits, Excel 2010 32 bits).
Je pige pas, tu dis "je ..." alors que tu nous as dis que le code venait de monsieur BOISGONTIER.

Mais comment se fait-il que le "Option Explicit" ne se réveille pas alors qu'on utilise une variable non définie et que c'est quand même son boulot que de nous en avertir ?
 

cp4

XLDnaute Barbatruc
Je pige pas, tu dis "je ..." alors que tu nous as dis que le code venait de monsieur BOISGONTIER.

Mais comment se fait-il que le "Option Explicit" ne se réveille pas alors qu'on utilise une variable non définie et que c'est quand même son boulot que de nous en avertir ?
Bonjour,

@TooFatBoy ;) : Je dis "je", car j'allais utiliser un Redim Preserve pour alimenter à chaque tour de boucles le tableau. C'est en consultant le site de Boisgontier que j'ai trouvé que dans certain de ces codes, il faisait des boucles pour déterminer au préalable les dimensions de son tableau. Et c'est ce que j'ai fais, mais j'ai juste supprimer le preserve du code initial.

Pour Option explicit, d'après les explications de @job75 Redim permet aussi de déclarer un tableau.

Bon dimanche.
 

TooFatBoy

XLDnaute Barbatruc
Merci pour tes éclaircissements 👍👍👍


C'est en consultant le site de Boisgontier que j'ai trouvé que dans certain de ces codes, il faisait des boucles pour déterminer au préalable les dimensions de son tableau.
C'est marrant que tu parles de ça parce que c'est aussi ce que j'envisage de faire dans un classeur sur lequel je travaille, pour voir si ça me fait gagner du temps d'exécution en évitant le Redim Preserve, qui doit bouffer pas mal de temps, à chaque boucle.
 

Discussions similaires

Réponses
2
Affichages
230

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG