liste droulante en cascades 5 niveaux

MOUFIBEL · 12 Mars 2012

Bonjour;

quelqu'un peut m'aidé en intitulé; Merci d'avance.

Cordialement

david84 · 13 Mars 2012

Re : liste droulante en cascades 5 niveaux

Re
1 Nommer la feuille contenant ta Base de données BDD.
Nommer la plage MaBD : onglet Formules=>bloc Noms définis=>définir un nom.
La formule à utiliser :

Code:

=DECALER(BDD!$A$2;;;NBVAL(BDD!$A:$A)-1;5)

2 Ouvrir l'éditeur VBE (ALT+F11) et coller le code ci-dessous (légèrement modifié) dans le module de la feuille contenant les menus déroulants (feuille "liste" dans le fichier joint).

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mondico, c, temp
  If Target.Column <= 5 And Target.Count = 1 Then
    Set mondico = CreateObject("Scripting.Dictionary")
    Select Case Target.Column
    
     Case 1
      Target.Offset(, 1) = ""
      Target.Offset(, 2) = ""
      Target.Offset(, 3) = ""
      Target.Offset(, 4) = ""
      For Each c In Application.Index([MaBD], , 1)
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
      Next c
      
     Case 2
      Target.Offset(, 1) = ""
      Target.Offset(, 2) = ""
      Target.Offset(, 3) = ""
      For Each c In Application.Index([MaBD], , 2)
        If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) Then
              mondico.Add c.Value, c.Value
        End If
      Next c
     
     Case 3
      Target.Offset(, 1) = ""
      Target.Offset(, 2) = ""
       For Each c In Application.Index([MaBD], , 3)
         If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) Then
            mondico.Add c.Value, c.Value
         End If
       Next c
       
     Case 4
      Target.Offset(, 1) = ""
       For Each c In Application.Index([MaBD], , 4)
         If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) And c.Offset(0, -3) = Target.Offset(0, -3) Then
            mondico.Add c.Value, c.Value
         End If
       Next c
       
     Case 5
       For Each c In Application.Index([MaBD], , 5)
         If Not mondico.Exists(c.Value) And _
           c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) And c.Offset(0, -3) = Target.Offset(0, -3) And _
            c.Offset(0, -4) = Target.Offset(0, -4) Then
              mondico.Add c.Value, c.Value
         End If
       Next c
       
    End Select
    
    If mondico.Count > 0 Then
        If mondico.Count = 1 Then
            Target = mondico.keys
        Else
            For Each c In mondico.items: temp = temp & c & ",": Next c
                Target.Validation.Delete
                Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
            End If
        End If
    End If
End Sub

A+

MOUFIBEL · 13 Mars 2012

Re : liste droulante en cascades 5 niveaux

Re; Merci infiniment david84 enfin j'ai pu le résourdre grace à toi.

Cordialement

A+

david84 · 13 Mars 2012

Re : liste droulante en cascades 5 niveaux

Re
suite à un petit bug sans conséquence majeur détecté (mais autant tenter de le régler), ci-joint code actualisé :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mondico, c, temp
  If Target.Column <= 5 And Target.Count = 1 Then
    Set mondico = CreateObject("Scripting.Dictionary")
    
    Select Case Target.Column
     Case 1
      Target.Offset(, 1) = "": Target.Offset(, 1).Validation.Delete
      Target.Offset(, 2) = "": Target.Offset(, 2).Validation.Delete
      Target.Offset(, 3) = "": Target.Offset(, 3).Validation.Delete
      Target.Offset(, 4) = "": Target.Offset(, 4).Validation.Delete
      For Each c In Application.Index([MaBD], , 1)
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
      Next c
      
     Case 2
      Target.Offset(, 1) = "": Target.Offset(, 1).Validation.Delete
      Target.Offset(, 2) = "": Target.Offset(, 2).Validation.Delete
      Target.Offset(, 3) = "": Target.Offset(, 3).Validation.Delete
      For Each c In Application.Index([MaBD], , 2)
        If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) Then
              mondico.Add c.Value, c.Value
        End If
      Next c
     
     Case 3
      Target.Offset(, 1) = "": Target.Offset(, 1).Validation.Delete
      Target.Offset(, 2) = "": Target.Offset(, 2).Validation.Delete
       For Each c In Application.Index([MaBD], , 3)
         If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) Then
            mondico.Add c.Value, c.Value
         End If
       Next c
       
     Case 4
      Target.Offset(, 1) = "": Target.Offset(, 1).Validation.Delete
       For Each c In Application.Index([MaBD], , 4)
         If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) And c.Offset(0, -3) = Target.Offset(0, -3) Then
            mondico.Add c.Value, c.Value
         End If
       Next c
       
     Case 5
       For Each c In Application.Index([MaBD], , 5)
         If Not mondico.Exists(c.Value) And _
           c.Offset(0, -1) = Target.Offset(0, -1) And _
            c.Offset(0, -2) = Target.Offset(0, -2) And c.Offset(0, -3) = Target.Offset(0, -3) And _
            c.Offset(0, -4) = Target.Offset(0, -4) Then
              mondico.Add c.Value, c.Value
         End If
       Next c
       
    End Select
    
    If mondico.Count > 0 Then
        Target.Validation.Delete
        If mondico.Count = 1 Then
            Target = mondico.keys
        Else
            For Each c In mondico.items: temp = temp & c & ",": Next c
                Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
            End If
        End If
    End If
End Sub

A+

Dranreb · 13 Mars 2012

Re : liste droulante en cascades 5 niveaux

Bonjour.
J’envoie quand même ma version, avec beaucoup de retard, le temps de comprendre de quoi il s'agissait et de mettre au point ma version dictionnaire du module MSansDoublon qui n'avait encore jamais été appliquée...
Nécessite la référence Microsoft Scripting Runtime qui évite le besoin d'utiliser CreateObject.
Cordialement.

P.S. Une deuxième version qui montre que la ligne où figure la combinaison peut être retrouvée simplement.
Son fonctionnement est aussi un peu plus sûr (construction dans Cascade du dictionnaire global s'il n'est pas initialisé)
À +

david84 · 14 Mars 2012

Re : liste droulante en cascades 5 niveaux

Bonsoir,
Petite amélioration de ma proposition : lorsque le dictionnaire ne compte qu'un item, la sélection de la cellule de droite incrémente automatiquement celle-ci (et le cas échéant les suivantes).

@Dranreb : j'ai pris le temps de regarder plus attentivement tes propositions et je veux te remercier pour le petit bijou que tu nous as concocté. Certains penseront peut-être que tu as sorti la "grosse artillerie" (module de classe, API,...) pour au final, peu de différence à 1ère vue avec ma proposition mais personnellement, je reste scotché devant ton travail et mesure la différence qui sépare ma proposition de la tienne.
Je pense que je n'ai pas fini de l'étudier afin de comprendre la manière dont tu t'y es pris.
J'espère que Moufibel repassera par-là, et que d'autres profiteront de ce travail.
Pour ma part, j'ai d'ores et déjà mis ton fichier "au chaud" et recommande amicalement à ceux intéressés par le sujet des listes en cascade d'en faire autant.
A+

Dranreb · 14 Mars 2012

Re : liste droulante en cascades 5 niveaux

Bonsoir david84
Merci pour ton chaleureux plébiscite.
Ne manque pas de me tenir informé des utilisations que tu y auras trouvées.
Et me signaler surtout d'éventuels défauts. Le module MDictionnArbo est encore un peu en rodage par rapport au MSansDoublon qui a fait ses preuves. Mais en vertu du principe "qui peut le plus peut le moins", il pourrait le remplacer partout, même pour des ComboBox bien qu'elles dispensent du besoin d'accès par clé.
Cordialement.

kerrigan · 20 Avril 2012

Re : liste droulante en cascades 5 niveaux

Bonjour à tous,

Dans le cadre de mon stage j'ai à effectuer une macro comprenant des listes déroulantes en cascade à 4 niveaux.
Pour ce faire je me suis inspiré d'un fichier, proposé par Rachid, présent dans cette discussion.
Cette méthode m'a semblé la plus simple vu mon faible niveau en macro/vba mais malgré ça je n'arrive pas à faire fonctionner les listes adaptées à mes données.

Si quelqu'un pouvait m'expliquer ou je me trompe dans la modification des fonctions ou la création des listes ce serait vraiment sympa parce que là je séche.

en pièces jointes le modèle(cascade) et le fichier modifié

Merci d'avance

BOISGONTIER · 20 Avril 2012

Re : liste droulante en cascades 5 niveaux

Bonjour,

>Ci-joint à tester une proposition VBA adaptée d'une idée de Jacques Boisgontier.

Attention! sur 2003, la longueur de la liste doit être <200 caractères et sur 2007, <8000 caractères.

JB

kerrigan · 23 Avril 2012

Re : liste droulante en cascades 5 niveaux

Bonjour Jacques,

Merci de votre réponse rapide.

J'ai étudié votre fichier et je n'arrive pas à comprendre l'intérêt de l'onglet combo ainsi que du code vba qu'il contient. n'est t'il pas possible de se contenter de deux onglets?

ci-joint le fichier modèle qui provient je crois de votre site
Cordialement

Kerrigan

Art94 · 29 Novembre 2020

Bonjour, je relance cet échange car je me retrouve en difficulté... Merci déjà pour ces solutions, j'ai testé celle de David84, en l'adaptant pour une liste en cascade avec 3 niveaux. Le hic, c'est que dans la quatrième colonne de ma feuille, j'ai besoin de faire la même chose que dans la troisième, mais en reportant les résultats issus des données entrées dans les colonnes 1 et 2... En résumé : cascade sur les trois premières colonnes, puis cascade sur les colonnes 1, 2 et 4...

J'en suis là :
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mondico, c, temp
If Target.Column <= 3 And Target.Count = 1 Then
Set mondico = CreateObject("Scripting.Dictionary")
Select Case Target.Column

Case 1
Target.Offset(, 1) = ""
Target.Offset(, 2) = ""
For Each c In Application.Index([projet_BDD2], , 1)
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c

Case 2
Target.Offset(, 1) = ""
For Each c In Application.Index([projet_BDD2], , 2)
If Not mondico.Exists(c.Value) And c.Offset(0, -1) = Target.Offset(0, -1) Then
mondico.Add c.Value, c.Value
End If
Next c

Case 3
For Each c In Application.Index([projet_BDD2], , 3)
If Not mondico.Exists(c.Value) And _
c.Offset(0, -1) = Target.Offset(0, -1) And _
c.Offset(0, -2) = Target.Offset(0, -2) Then
mondico.Add c.Value, c.Value
End If
Next c

End Select

If mondico.Count > 0 Then
If mondico.Count = 1 Then
Target = mondico.keys
Else
For Each c In mondico.items: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If
End If
End If
End Sub

Et je sèche...

Est-ce quelqu'un pourrait m'aider ? Merci beaucoup p

Compte Supprimé 979 · 29 Novembre 2020

Art94 à dit:
Bonjour, je relance cet échange car je me retrouve en difficulté... Merci déjà pour ces solutions, j'ai testé celle de David84, en l'adaptant pour une liste en cascade avec 3 niveaux. Le hic, c'est que dans la quatrième colonne de ma feuille, j'ai besoin de faire la même chose que dans la troisième, mais en reportant les résultats issus des données entrées dans les colonnes 1 et 2... En résumé : cascade sur les trois premières colonnes, puis cascade sur les colonnes 1, 2 et 4...

Est-ce quelqu'un pourrait m'aider ? Merci beaucoup

Bonsoir Art94,

Si tu veux que quelqu'un puisse t'aider, merci de joindre un fichier SVP

@+

liste droulante en cascades 5 niveaux

MOUFIBEL

XLDnaute Nouveau

Pièces jointes

david84

XLDnaute Barbatruc

Pièces jointes

MOUFIBEL

XLDnaute Nouveau

david84

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

david84

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

kerrigan

XLDnaute Nouveau

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

Pièces jointes

kerrigan

XLDnaute Nouveau

Pièces jointes

Art94

XLDnaute Nouveau

Compte Supprimé 979

Guest

Discussions similaires