XL 2019 VBA - Liste déroulante à partir de cellules d'une autre feuille

[im_Guillaume]

Bonjour,

Je suis novice en VBA et j'essaie d'implémenter la situation suivante :

Dans l'onglet 1, l'utilisateur doit choisir parmi une liste de métiers.
Cette liste se trouve dans l'onglet 2 et comprend des doublons qu'il faut ne compter qu'une fois.

Dans l'exemple ci-joint, la liste que je souhaiterais avoir serait donc : boulanger, boucher, fleuriste.

J'ai essayer de coder mais cela ne fonctionne pas :

Private Sub Worksheet_Change(ByVal target As Range)
'Liste déroulante des métiers (C5)
'Déclaration des variables
Dim Plage_Listes As Range
Dim Liste As String

'Initialisation des variables
Set Plage_Listes = Sheets("Choix").Range("C5")
Listes = Application.Goto(ActiveWorkbook.Sheets("Liste").Range("C5:C16").Value)
'Génération de la liste déroulante
With Plage_Listes.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Liste1
.IgnoreBlank = False
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With

End Sub


Merci pour toute l'aide que vous pourrez m'apporter!

 

[Robert]

Bonjour Guillaume, bonjour le forum,

Ton fichier modifié en pièce jointe.
Le code principal dans le module standard Module1 :

Sub Macro1()
Dim OC As Worksheet 'déclare la variable OC (Onglet Choix)
Dim OL As Worksheet 'déclare la variable OL (Onglet Liste)
Dim CC As Range 'déclare la variable CC (Cellule Cible)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim L As String 'déclare la variable L (Liste)

Set OC = Worksheets("Choix") 'définit l'onglet OC
Set OL = Worksheets("Liste") 'définit l'onglet OL
Set CC = OC.Range("C5") 'définit la cellule cible CC
TV = OL.Range("C4").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
Next I 'prochaine ligne de la boucle
L = Join(D.Keys, ",") 'définit la liste L (la réunion de l'ensemble des éléments du dictionnaire D sans doublon (les clés), séparés par une virgule)
With CC.Validation 'prend en compote la validation de donnée de la cellule CC
    .Delete 'efface une eventuelle validation
    .Add xlValidateList, Formula1:=Lst 'ajoute la validation avec L comme Liste
End With 'fin de la prise en compte de validation de données de la cellule CC
End Sub

Pour qu'il agisse dès l'ouverture du classeur, le code dans le composant ThisWorkbook :

Private Sub Workbook_Open()
Module1.Macro1
End Sub

Et pour qu'il s'actualise si tu modifies la liste, le code dans le composant Feuil2 (Liste) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then Module1.Macro1
End Sub

 

[Efgé]

Bonjour @im_Guillaume , Bonjour @Robert
Si @im_Guillaume à accès à UNIQUE, une proposition par formules
une formule en feuille "Validation"

=UNIQUE(MAJUSCULE(DECALER(Liste!$C$5;;;NBVAL(Liste!$C5:$C10000))))

Et une plage nommée dynamique "ListeChoix" dans le gestionnaire de noms

=DECALER(Validation!$A$1;;;NBVAL(Validation!$A:$A))

J'ai mis en Majuscule car il y a un risque de retrouver "boucher" et "Boucher"

Cordialement

 

[im_Guillaume]

Robert et Efgé, un grand merci pour votre réactivité et vos réponses !

Robert, je comprends votre code et il fonctionne globalement mais j'ai cependant un souci de variable : lorsque j'ouvre l'excel, voici le message d'erreur qu'il m'affiche. Savez-vous pourquoi?

Efgé, je ne sais pas si le bug est de mon côté mais je n'arrive pas à ouvrir votre document pour l'instant.

 

[im_Guillaume]

Robert, j'ai trouvé d'où venait l'erreur : le "Lst" est à remplacer par "L" tout simplement. Merci beaucoup pour votre aide!

 

[Efgé]

Re

Efgé, je ne sais pas si le bug est de mon côté mais je n'arrive pas à ouvrir votre document pour l'instant.

Je le remet ici, au cas ou...

 

[im_Guillaume]

Merci Efgé, votre méthode fonctionne également! Merci pour vos réponses, le plus dur c'est de choisir maintenant

 

[Robert]

Bonjour le fil, bonjour le forum,

Sans aucun doute la solution d'Efgé, que je salue au passage, sans VBA est la meilleure (même si je hais les formulistes car ils sont trop forts... )

 

[im_Guillaume]

Bonjour Guillaume, bonjour le forum,

Ton fichier modifié en pièce jointe.
Le code principal dans le module standard Module1 :

Sub Macro1()
Dim OC As Worksheet 'déclare la variable OC (Onglet Choix)
Dim OL As Worksheet 'déclare la variable OL (Onglet Liste)
Dim CC As Range 'déclare la variable CC (Cellule Cible)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim L As String 'déclare la variable L (Liste)

Set OC = Worksheets("Choix") 'définit l'onglet OC
Set OL = Worksheets("Liste") 'définit l'onglet OL
Set CC = OC.Range("C5") 'définit la cellule cible CC
TV = OL.Range("C4").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec les données en colonne 1 de TV
Next I 'prochaine ligne de la boucle
L = Join(D.Keys, ",") 'définit la liste L (la réunion de l'ensemble des éléments du dictionnaire D sans doublon (les clés), séparés par une virgule)
With CC.Validation 'prend en compote la validation de donnée de la cellule CC
    .Delete 'efface une eventuelle validation
    .Add xlValidateList, Formula1:=Lst 'ajoute la validation avec L comme Liste
End With 'fin de la prise en compte de validation de données de la cellule CC
End Sub

Pour qu'il agisse dès l'ouverture du classeur, le code dans le composant ThisWorkbook :

Private Sub Workbook_Open()
Module1.Macro1
End Sub

Et pour qu'il s'actualise si tu modifies la liste, le code dans le composant Feuil2 (Liste) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then Module1.Macro1
End Sub

Bonjour Robert,

Ayant constaté que tous les ordinateurs n'avaient pas une version d'excel à jour (permettant d'implémenter la version d'Efgé), j'ai décidé d'utiliser votre VBA.

Mais voici mon problème :
Je souhaiterais appliquer votre code à toutes les colonnes de l'onglet "Liste" et ainsi pouvoir choisir dans l'onglet "choix" :
- Un métier parmi les métier de la colonne C de l'onglet "liste"
- Un genre parmi les genres de la colonne D de l'onglet "liste"
- Un Prénom parmi les prénoms de la colonne E de l'onglet "liste".

J'ai essayé d'implémenter ça pour la colonne D mais la liste me propose les mêmes choix que la colonne C.
Identifiez-vous le problème?

Merci encore pour aide!

 

[Robert]

Bonjour le fil, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai utilisé une autre méthode avec les événementielles Change et SelectionChange...

 

[im_Guillaume]

Merci pour votre réponse Robert!

Ne pourrait-on pas garder l'ancienne méthode en l'appliquant au nouveau cas?
Voilà 2 problèmes rencontrés avec votre nouvelle version :

- la liste déroulante de la case "choix de prénom" n'affiche pas tous les prénoms

- Lorsque je sélectionne en premier "Mme" par exemple dans liste déroulante "choix du sexe", puis que je change le "choix de métier" par la suite, mon premier choix s'efface.
Est-ce possible de tout simplement supprimer la ligne de code
" Range("D5:E5").ClearContents 'efface la plage D5:E5"
Ou cela aura d'autres répercussions?

 

[Robert]

Ne pourrait-on pas garder l'ancienne méthode en l'appliquant au nouveau cas?

À qui le dis-tu !... Ne pourrais-tu pas changer de cas à chaque post...

La liste n'affiche que les prénoms des personnes ayant le métier choisi et le sexe choisi (c'est le but il me semble). Je préfère effacer pour ne pas me retrouver avec un prénom qui ne devrais pas apparaître...

 

[im_Guillaume]

Merci pour votre réponse,
Je voyais d'avantage ça comme des filtres initialement, mais je comprends maintenant votre logique et elle est bien meilleure.
Pardon pour ma "novicitude"

Merci encore pour votre temps,

 

[Stéphane_1]

Bonjour le fil, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai utilisé une autre méthode avec les événementielles Change et SelectionChange...

Bonjour,

Merci pour votre code ! Je l'ai repris pour effectuer des recherches dans un inventaire de barre métallique. J'ai essayé de l'adapter mais je me retrouve avec 2 problèmes : la dernière colonne reprend les choix de la précédente (donc E propose les choix de D), et le dictionnaire ne se limite pas en fonction des choix précédents (le choix de la matière devrait limiter les choix de la nuance, mais ce n'est pas le cas).

Est-ce que pourriez regarder ce que j'ai modifié et me dire si vous repérez un problème ?

Select Case Target.Address 'agit en fonction de l'adresse de la cellule sélectionnée
    
    Case "$A$2" 'cas A2
        TEST = True
        COL = 1 'définit la colonne COL
        Range("B2:E2").ClearContents 'efface la plage B2:E2
        If Target.Value = "" Then TEST = False: Exit Sub
        L = "" 'vide la liste L
        
    Case "$B$2" 'cas B2
        TEST = True
        COL = 2 'définit la colonne COL
        Range("D2:E2").ClearContents 'efface la plage D2:E2
        If Target.Value = "" Then TEST = False: Exit Sub
        L = "" 'vide la liste L
        
    Case "$C$2" 'cas C2
        TEST = True
        COL = 3 'définit la colonne COL
        Range("D2:E2").ClearContents 'efface la plage D2:E2
        If Target.Value = "" Then TEST = False: Exit Sub
        L = "" 'vide la liste L
        
    Case "$D$2" 'cas D2
        TEST = True
        COL = 4 'définit la colonne COL
        Range("E2").ClearContents 'efface la cellule E2
        Range("E2").Validation.Delete 'efface la validation de données en E2
        If Target.Value = "" Then TEST = False: Exit Sub
        L = "" 'vide la liste L
        
End Select 'fin de l'action en fonction de l'adresse de la cellule sélectionnée

For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    
    'alimente le dictionnaire D avec les données de TV en fonction de ce qui a déjà été remplis
    If TV(I, 1) = Range("A2").Value Then D(TV(I, 2)) = "" And D(TV(I, 3)) = ""
    If TV(I, 2) = Range("B2").Value Then D(TV(I, 3)) = ""
    If TV(I, 3) = Range("C2").Value Then D(TV(I, 2)) = ""
    If TV(I, 4) = Range("D2").Value Then D(TV(I, 5)) = ""
    
Next I 'prochaine ligne de la boucle