Microsoft 365 Listes déroulantes dépendantes & autonomes

kevinl66

XLDnaute Nouveau
Bonjour,

Après de nombreuses recherches sur internet et sur ce forum, après avoir épluché des discussions et testé des formules (excel/macro-vba), je me vois contraint de demander de l'aide.
Je cherche à créer 2 listes déroulantes dépendantes et indépendantes à la fois.

Dans l'idée :
- Lorsque l'on sélectionne une information dans la première liste, on a la correspondance automatiquement affichée sur la seconde.
- Lorsque l'on sélectionne une information dans la seconde, la correspondance se modifie automatiquement dans la première.
- Je ne veux pas faire de condition avec SI(A1="aa";"ab";SI(..... ça serait trop long et complexe, et ça ne fonctionne pas...
- Je ne veux pas lier les 2 cellules en 1 dans le style concaténer car j'ai besoin des 2 informations séparément pour d'autres paramètres indépendants.

J'espère que les informations de ma demande sont claires, sinon n'hésitez pas à me dire.
Je vous joins un fichier synthétisé de ce que je recherche à faire.

Merci pour vos retours,
Kévin.
 

Pièces jointes

  • ListesDependantes.xlsx
    13.9 KB · Affichages: 7
Solution
Bonjour Kevin,
Il y a quelques trucs qui je ne comprends pas dans votre code :
1- Si C2 contient DEPARTEMENTS alors il exécute DEPART, puis PAYS puisqu'il n'y a pas d' Exit sub.
2- Si C2 ne contient aucune des deux valeurs, alors il exécute DEART puis PAYS car il n'y a pas de sortie.
3- Les GOTO sont à éviter quand c'est possible, il sont souvent sources de problèmes.
Pourquoi ne pas utiliser un CASE, cela simplifie le code :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    Select Case Range("C2").Value
        Case "DEPARTEMENTS"
            If Not Intersect(Target, [B5]) Is Nothing Then
                Ligne = Application.Match([B5], [H1:H99], 0)
                [E5] =...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kevin,
Un essai en PJ avec cette macro :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [H1:H99], 0)
        [E5] = Cells(Ligne, "I")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [I1:I99], 0)
        [B5] = Cells(Ligne, "H")
    End If
Fin:
    Application.EnableEvents = True
End Sub
 

Pièces jointes

  • ListesDependantes.xlsm
    17.7 KB · Affichages: 2

kevinl66

XLDnaute Nouveau
Bonjour Sylvanu,

Merci pour ce retour si rapide.
Je viens de tester et suis ravi car ça fonctionne super !

J'ai essayé d'adapter la macro à la condition précédente choisie (Départements ou Pays).
J'ai bien mes listes qui se changent en fonction de ça, mais malheureusement la macro dupliquée et adaptée ne s'applique pas aux nouvelles listes...

EDIT : Quand je sélectionne le 2eme code, en haut le "Worksheet / Change" est remplacé par "(Général) / Worksheet_Change2", si ça peut aider...

Je joins le nouveau fichier pour suivi.

Merci pour vos contributions,
Kévin.
VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [H1:H99], 0)
        [E5] = Cells(Ligne, "I")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [I1:I99], 0)
        [B5] = Cells(Ligne, "H")
    End If
Fin:
    Application.EnableEvents = True
End Sub
Sub Worksheet_Change2(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [K1:K11], 0)
        [E5] = Cells(Ligne, "L")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [L1:L11], 0)
        [B5] = Cells(Ligne, "K")
    End If
Fin:
    Application.EnableEvents = True
End Sub
 

Pièces jointes

  • ListesDependantes.xlsm
    20.3 KB · Affichages: 3

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Voir PJ avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [K1:K11], 0)
        [E5] = Cells(Ligne, "L")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [L1:L11], 0)
        [B5] = Cells(Ligne, "K")
    End If
Fin:
Application.EnableEvents = True
End Sub
I
 

Pièces jointes

  • ListesDependantes V2.xlsm
    19.3 KB · Affichages: 6

kevinl66

XLDnaute Nouveau
Re,

Encore merci.
La nouvelle macro correspond à la nouvelle liste (PAYS) mais n'intègre plus la première (DEPT.) qui fonctionnait initialement...

Avec ce code, quand l'option "PAYS" est sélectionnée, les listes PAYS et NPAYS s'actualisent l'une-l'autre sans problème. Mais si je change l'option par "DEPARTEMENTS", les listes DEPT et NDEPT s'affichent bien mais ne s'actualisent pas (Sur la première macro c'était l'inverse).
C'est pour cette raison que j'avais essayé de la dupliquer ; pour qu'elle s'applique avec n'importe quelle option.

Je ne sais pas si mon explication est compréhensible ?

Merci à vous,
Kévin.

PS : À savoir que mon fichier final comprend 4 points de départs et 16 feuilles/listes différentes avec des avertissements dans les cases en fonction des informations choisies... Mais tout ça est déjà en place, il ne me manque que cette fonction.
 
Dernière édition:

kevinl66

XLDnaute Nouveau
Bonjour,

Après un petit casse-tête et avec l'aide du code de Sylvanu, j'ai réussi à obtenir ce que je souhaitais !

J'ai ajouté une condition avant l'exécution du code, je vous joins le tout ci-dessous pour ceux que ça intéresse.

Encore merci pour l'aide.
Kévin.

VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    If Range("C2").Value = "DEPARTEMENTS" Then GoTo DEPART
    If Range("C2").Value = "PAYS" Then GoTo PAYS
DEPART:
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [H1:H99], 0)
        [E5] = Cells(Ligne, "I")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [I1:I99], 0)
        [B5] = Cells(Ligne, "H")
    End If
PAYS:
    If Not Intersect(Target, [B5]) Is Nothing Then
        Ligne = Application.Match([B5], [K1:K11], 0)
        [E5] = Cells(Ligne, "L")
    ElseIf Not Intersect(Target, [E5]) Is Nothing Then
        Ligne = Application.Match([E5], [L1:L11], 0)
        [B5] = Cells(Ligne, "K")
    End If
Fin:
    Application.EnableEvents = True

End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kevin,
Il y a quelques trucs qui je ne comprends pas dans votre code :
1- Si C2 contient DEPARTEMENTS alors il exécute DEPART, puis PAYS puisqu'il n'y a pas d' Exit sub.
2- Si C2 ne contient aucune des deux valeurs, alors il exécute DEART puis PAYS car il n'y a pas de sortie.
3- Les GOTO sont à éviter quand c'est possible, il sont souvent sources de problèmes.
Pourquoi ne pas utiliser un CASE, cela simplifie le code :
VB:
Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    Application.EnableEvents = False
    Select Case Range("C2").Value
        Case "DEPARTEMENTS"
            If Not Intersect(Target, [B5]) Is Nothing Then
                Ligne = Application.Match([B5], [H1:H99], 0)
                [E5] = Cells(Ligne, "I")
            ElseIf Not Intersect(Target, [E5]) Is Nothing Then
                Ligne = Application.Match([E5], [I1:I99], 0)
                [B5] = Cells(Ligne, "H")
            End If
        Case "PAYS"
            If Not Intersect(Target, [B5]) Is Nothing Then
                Ligne = Application.Match([B5], [K1:K11], 0)
                [E5] = Cells(Ligne, "L")
            ElseIf Not Intersect(Target, [E5]) Is Nothing Then
                Ligne = Application.Match([E5], [L1:L11], 0)
                [B5] = Cells(Ligne, "K")
            End If
        End Select
Fin:
    Application.EnableEvents = True
End Sub

Evidemment si mes hypothèses sont fausses et que c'est ce que vous recherchiez, alors mes excuses. :)
 

kevinl66

XLDnaute Nouveau
Re,

Lors des tests il n'y avait pas d'erreur ou de blocage, d'où ma satisfaction :)

Je viens de tester votre code et le résultat semble le même, mais si vous pensez que la syntaxe est préférable alors je vais appliquer celui-ci !

En vous remerciant.
 

Discussions similaires

Statistiques des forums

Discussions
315 096
Messages
2 116 184
Membres
112 679
dernier inscrit
Yupanki