XL 2019 problème liste déroulante

[Mimi1952]

Bonjour, à tous je suis un petit nouveau et j'ai besoin d'aide, merçi pour vos conseils a venir .Voilà ! J'ai actuellement un code qui me permet qu'en indiquant un code postal une liste
déroulante avec les différentes communes rattachées a ce CP s'ouvre, cela est parfait .
Mais je voudrais en plus (et c'est là le problème ),avoir une liste déroulante avec certaines communes
Car j'ai une liste de 93 clubs et je souhaiterais qu'en cliquant par exemple sur la commune SAINT AGNAN
avoir une liste déroulante qui affiche que le nom du club, mais je ne veux qu'il m'affiche la liste déroulante
avec les 93 clubs. Ou alors , une liste déroulante par département, car il y à des départements qui ont
4 ou 5 clubs ( par exemple les clubs du départements 71 et 53.
Sur mon souhait les lignes en couleur rose se sont des lignes en double car cela peut se reproduire
plusieurs fois sur la colonne

 

[Robert]

Bonjour Mimi et bienvenu, bonjour le forum,

Attention il te faut vérifier que les villes dans la liste des clubs soient bien identiques aux villes dans la liste des codes postaux. Tu avais ST AGNAN et SAINT AGNAN !....
En pièce jointe ton fichier modifié avec le code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OC As Worksheet 'déclare la variable OC (Onglet Codepostal)
Dim TCO As Variant 'déclare la variable TCO (Tableau des COdes)
Dim TCL As Variant 'déclare la variable TCL (Tableau des CLubs)
Dim I As Long 'déclare la variable I (Incrémemt)
Dim L As String 'déclare la variable L (Liste)
Dim N As Integer 'déclare la variable N (Nombre)

On Error GoTo fin 'gestion des erreurs (en cas d'erreur va à l'étiquette "fin")
If Target.Row = 1 Then Exit Sub 'si le changement a lieu dans la ligne 1 sort de la procédure
Set OC = Worksheets("codepostal") 'définit l'onglet OC
TCO = OC.Range("A1").CurrentRegion 'définit le tableau TCO
TCL = OC.Range("E1").CurrentRegion 'définit le tableau TCL

Select Case Target.Column 'agit en fonction de la colonne où a lieu le changement
    Case 3 'cas 3 (=C)
        Target.Offset(0, 1).Resize(1, 2).ClearContents 'supprime une éventuelle validation de données dans les colonnes 4 et 5
        Target.Offset(0, 1).Resize(1, 2).Validation.Delete 'efface les cellules en colonnes 4 et 5 (cela génèrera pour la cas 4 une erreur)
        For I = 2 To UBound(TCO, 1) 'boucle sur toutes les lignes I du tableau TCO (en partant de la seconde)
            'si la donnée ligne I colonne 2 de TCO est égale au code de la cellue modifiée, redéfinit la liste L et incrémente le nombre N
            If TCO(I, 2) = Target.Value Then L = IIf(L = "", TCO(I, 1), L & "," & TCO(I, 1)): N = N + 1
        Next I 'prochaine 'ligne de la boucle
        If N = 1 Then 'condition : si N vaut 1
            Target.Offset(0, 1).Value = L 'renvoie L dans la cellule en colonne 4
        Else 'sinon
            Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de donnée  dans la cellule en colonne 4
            CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste
        End If 'fon de la condition
        Target.Offset(0, 1).Select 'sélectionne la cellue en colonne 4
    Case 4 'cas 4 (=D)
        Target.Offset(0, 1).Validation.Delete 'supprime une éventuelle validation de données dans la colonne 5
        Target.Offset(0, 1).ClearContents 'efface la cellule en colonne 5
        L = "": N = 0 'efface L, initialise N
        For I = 2 To UBound(TCL, 1) 'boucle sur toutes les lignes I du tableau TCL (en partant de la seconde)
            'si la donnée ligne I colonne 5 de TCL est ágale à la cellue modifiée, redéfinit la liste L et incrémente N
            If TCL(I, 2) = Target.Value Then L = IIf(L = "", TCL(I, 3), L & "," & TCL(I, 3)): N = N + 1
        Next I 'prochaine 'ligne de la boucle
        If N = 0 Then Exit Sub 'si N vaut zéro, sort de la procédure
        If N = 1 Then 'si N vaut 1 renvoie L dans la cellule en colonne 5
            Target.Offset(0, 1).Value = L
        Else 'sinon
            Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de donnée dans la cellule en colonne 5
            CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste
        End If 'fin de la condition
        Target.Offset(0, 1).Select 'sélectionne la cellue en colonne 5
End Select 'fin de l'action en fonction de la colonne où a lieu le changement
fin: 'étiquette
End Sub

Le fichier :

 

[Mimi1952]

Bonjour Mimi et bienvenu, bonjour le forum,

Attention il te faut vérifier que les villes dans la liste des clubs soient bien identiques aux villes dans la liste des codes postaux. Tu avais ST AGNAN et SAINT AGNAN !....
En pièce jointe ton fichier modifié avec le code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OC As Worksheet 'déclare la variable OC (Onglet Codepostal)
Dim TCO As Variant 'déclare la variable TCO (Tableau des COdes)
Dim TCL As Variant 'déclare la variable TCL (Tableau des CLubs)
Dim I As Long 'déclare la variable I (Incrémemt)
Dim L As String 'déclare la variable L (Liste)
Dim N As Integer 'déclare la variable N (Nombre)

On Error GoTo fin 'gestion des erreurs (en cas d'erreur va à l'étiquette "fin")
If Target.Row = 1 Then Exit Sub 'si le changement a lieu dans la ligne 1 sort de la procédure
Set OC = Worksheets("codepostal") 'définit l'onglet OC
TCO = OC.Range("A1").CurrentRegion 'définit le tableau TCO
TCL = OC.Range("E1").CurrentRegion 'définit le tableau TCL

Select Case Target.Column 'agit en fonction de la colonne où a lieu le changement
    Case 3 'cas 3 (=C)
        Target.Offset(0, 1).Resize(1, 2).ClearContents 'supprime une éventuelle validation de données dans les colonnes 4 et 5
        Target.Offset(0, 1).Resize(1, 2).Validation.Delete 'efface les cellules en colonnes 4 et 5 (cela génèrera pour la cas 4 une erreur)
        For I = 2 To UBound(TCO, 1) 'boucle sur toutes les lignes I du tableau TCO (en partant de la seconde)
            'si la donnée ligne I colonne 2 de TCO est égale au code de la cellue modifiée, redéfinit la liste L et incrémente le nombre N
            If TCO(I, 2) = Target.Value Then L = IIf(L = "", TCO(I, 1), L & "," & TCO(I, 1)): N = N + 1
        Next I 'prochaine 'ligne de la boucle
        If N = 1 Then 'condition : si N vaut 1
            Target.Offset(0, 1).Value = L 'renvoie L dans la cellule en colonne 4
        Else 'sinon
            Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de donnée  dans la cellule en colonne 4
            CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste
        End If 'fon de la condition
        Target.Offset(0, 1).Select 'sélectionne la cellue en colonne 4
    Case 4 'cas 4 (=D)
        Target.Offset(0, 1).Validation.Delete 'supprime une éventuelle validation de données dans la colonne 5
        Target.Offset(0, 1).ClearContents 'efface la cellule en colonne 5
        L = "": N = 0 'efface L, initialise N
        For I = 2 To UBound(TCL, 1) 'boucle sur toutes les lignes I du tableau TCL (en partant de la seconde)
            'si la donnée ligne I colonne 5 de TCL est ágale à la cellue modifiée, redéfinit la liste L et incrémente N
            If TCL(I, 2) = Target.Value Then L = IIf(L = "", TCL(I, 3), L & "," & TCL(I, 3)): N = N + 1
        Next I 'prochaine 'ligne de la boucle
        If N = 0 Then Exit Sub 'si N vaut zéro, sort de la procédure
        If N = 1 Then 'si N vaut 1 renvoie L dans la cellule en colonne 5
            Target.Offset(0, 1).Value = L
        Else 'sinon
            Target.Offset(0, 1).Validation.Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de donnée dans la cellule en colonne 5
            CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste
        End If 'fin de la condition
        Target.Offset(0, 1).Select 'sélectionne la cellue en colonne 5
End Select 'fin de l'action en fonction de la colonne où a lieu le changement
fin: 'étiquette
End Sub

Le fichier :

Bonsoir, Robert
Je te remercie pour ta rapidité d'avoir répondu a mon message, j'ai essayer vite fait sur le fichier modifié et cela semble répondre a mon problème .Demain je verrais en mettant sur mon classeur ce que ca donne .Je te tiens au courant de l'évolution .Merci encore c'est sympa.

 

[Mimi1952]

Bonsoir, Robert
Je te remercie pour ta rapidité d'avoir répondu a mon message, j'ai essayer vite fait sur le fichier modifié et cela semble répondre a mon problème .Demain je verrais en mettant sur mon classeur ce que ca donne .Je te tiens au courant de l'évolution .Merci encore c'est sympa.

Bonjour Robert,

Sur le fichier que tu m'as envoyer ça fonctionne bien mais quand j'ai voulu l'installer sur mon classeur je n'ai rien.

Alors, est ce que? je doit laisser le code qui été installer au-paravent pour mes codes postaux et les communes , je l'ai enlevé et rien ne se passe ,

Ensuite je pense qu'il faut modifier certaines colonnes car sur mon classeur Final " Inscriptions"

Les CP se trouve colonne G donc 7éme colonne

Les Villes colonne H donc 8 éme colonne

et les Club colonne I donc 9 éme colonne

Mais là , j'ai beau regarder ton code je ne sais pas quoi faire .

En PJ : Je joints une copie de mon classeur final .

Merçi pour ton aide.

 

[Robert]

Re,

Tu m'étonnes que ça ne marche pas !... Dans le premier fichier tu avais, dans les colonnes E à G de l'onglet codepostal un tableau qui n'est plus dans CopieMimi_ED_v01(1).xlsm. Ce sont les données de ce tableau qui permettaient le fonctionnement... Mais là, le fichier onglet données.xlsx n'affichent ni le code postal ni les communes. je ne comprends plus rien (et toi non plus visiblement)... Si tu reproduis le premier exemple ça devrait marcher.

 

[Mimi1952]

Re,

Tu m'étonnes que ça ne marche pas !... Dans le premier fichier tu avais, dans les colonnes E à G de l'onglet codepostal un tableau qui n'est plus dans CopieMimi_ED_v01(1).xlsm. Ce sont les données de ce tableau qui permettaient le fonctionnement... Mais là, le fichier onglet données.xlsx n'affichent ni le code postal ni les communes. je ne comprends plus rien (et toi non plus visiblement)... Si tu reproduis le premier exemple ça devrait marcher.

Bonjour Robert,

Grâce a toi j'ai pu mettre mes codes postaux avec les villes et les clubs ,tout fonctionne parfaitement .J'ai compris qu'il fallait vérifier l'orthographe des villes avec celle de la liste des CP et modifié "case 3" par "case 7" et idem pour "case4" par case8 ,ce qui correspond aux colonnes de mes CP et Villes dans le code que tu m'a proposer .
Maintenant, je voudrais joindre aussi une nouvelle liste déroulante concernant les Mail qui s'ouvrirait pour chaque club. Je voudrais que ce soit dans la continuité de ce que j'ai déjà donc:
CP/villes/club/+ maintenant les mail.
autre petite question, sais tu à quoi correspond les 2 cases situées à gauche de mon classeur juste avant les numéros de lignes avec les N°1et 2 .Je pense que j'ai dù faire une manip qu'il ne fallait pas et je n'arrive pas a supprimer ces 2 cases.
je te joint un fichier

 

[Mimi1952]

Bonjour,
Pouvez-vous m'aidez ,svp je veux gérer un concours de molkky , j'ai déjà un code que Robert m'a créer et grâce à ce code VBA je peu avoir mes codes postaux qui ouvrent automatiquement mes villes qui elles ouvrent aussi automatiquement le nom des clubs lorsqu'un club correspond à une ville .Je voudrais maintenant que quand je sélectionne un club cela ouvre aussi automatiquement le mail correspondant a ce club . il y à 56 clubs donc autant de mails. Je vous remerçie pour vos réponses à venir.