Liste de validation en cascade sur cinq niveaux

Bonjour amis lecteurs et membres du forum,

Je suis amateur "peu éclairé" avec Excel et je bute sur une question.

Quelqu'un saurait-il faire une liste de validation en cascade sur cinq niveaux maximum avec affichage et saisie dans une seule cellule, que ce soit avec ou sans macro, avec un userform ou toute autre solution efficace.

À noter : la BDD source devrait changer rarement.

Je joins un fichier pour illustrer la structure type de la BDD.

Merci d'avance pour votre aide et vos suggestions.

Bonjour,

As-tu pris le temps de regarder les 6 discussions au bas de cette même page ...???

Bonjour,

Exemple avec 4 niveaux

http://boisgontierjacques.free.fr/fichiers/DonneesValidation/MenuDeroulantIndent.xls

Boisgontier

Bonjour James007 et Boisgontierjacques,

Merci de vous intéresser à ma question et d'y avoir répondu.

À James007 : j'ai effectivement fait un grand bond (lol) vers les sujets traités sur ce forum ... et même un peu partout sur le net, mais je n(ai, jusqu'à présent, rien trouvé qui réponde à ma question, à savoir faire une liste de validation à cinq niveaux sur UNE SEULE ET MÊME CELLULE

À Boisgontierjacques : voir ci-dessus, l'exemple transmis demande quatre cellules de choix successifs, j'aimerais obtenir le même résultat mais en utilisant une seule et même cellule pour la sélection.

Merci encore de votre intérêt.

Re,

Donc ... en rèsumé ... une Validation en Cascade sur 5 Niveaux ....

sur UNE SEULE ET MÊME CELLULE

Voilà du véritable Équilibrisme

Quelles sont donc les contraintes qui te poussent à vouloir cette solution ..???

Il ne reste qu'à coder la macro évènementielle ...

Exemple avec une BD normale.

Dim zSaisie, NbNiv, NivCourant, TblBD()
Dim choix(1 To 6)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set zSaisie = Range("B2:B5")
    NbNiv = 4
    If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
      TblBD = [Tableau1].Value
      Set d1 = CreateObject("Scripting.Dictionary")
      Set result = [Tableau1].Find(what:=Target)
      If result Is Nothing Then
        NivCourant = 1
      Else
        NivCourant = result.Column + 1
      End If
      If NivCourant > NbNiv Then NivCourant = 1
      Dim Tmp(): ReDim Tmp(1 To NivCourant)
      For i = 1 To UBound(TblBD)
         témoin = True
         For k = 1 To NivCourant - 1
            If TblBD(i, k) <> choix(k) Then témoin = False: Exit For
         Next k
         If témoin Then d1(TblBD(i, NivCourant)) = ""
       Next i
       If d1.Count > 0 Then
           temp = Join(d1.keys, ",")
           Target.Validation.Delete
           If temp <> "" Then Target.Validation.Add xlValidateList, Formula1:=temp
        End If
    End If
 End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
       choix(NivCourant) = Target.Value
       Set d1 = CreateObject("Scripting.Dictionary")
       NivCourant = NivCourant + 1
       If NivCourant > NbNiv Then Target.Offset(, 1).Select: Exit Sub
       Dim Tmp(): ReDim Tmp(1 To NivCourant)
       For i = 1 To UBound(TblBD)
         témoin = True
         For k = 1 To NivCourant - 1
            If TblBD(i, k) <> choix(k) Then témoin = False: Exit For
         Next k
         If témoin Then d1(TblBD(i, NivCourant)) = ""
        Next i
        If d1.Count > 0 Then
           temp = Join(d1.keys, ",")
           Target.Validation.Delete
           If temp <> "" Then Target.Validation.Add xlValidateList, Formula1:=temp
        End If
    End If
End Sub

Boisgontier

Version menu déroulant une cellule avec BD indentation.

Boisgontier

NICKEL !!!!

Comme d'habitude, Boisgontierjacques ne déçoit jamais !

Énorme MERCIIIII !

Du grand art !