[Résolu] Liste déroulante - 3ème niveau défectueux

[Jahvik]

Bonjour tout le monde,

Tout d'abord, merci à toutes et à tous pour votre aide si précieuse. Cela m'a grandement permis de progresser sur les listes deroulantes

En fait, concernant le fichier joint, pour ma colonne D appelée "Denomination" de la feuille "Selection", lorsque je fais "Validation de données", j'ai comme erreur "la source est reconnue comme erronée" alors que j'ai scrupuleusement suivi le programme VBA pour les listes en cascade.

Et malgré toutes mes recherches, je n'ai rien trouvé
Si vous avez une idée, je l'accueillerais avec grand plaisir. Merci pour tout !

 

[BOISGONTIER]

Re : Liste déroulante - 3ème niveau défectueux

Bonjour,

Voir pj

JB

 

[R@chid]

Re : Liste déroulante - 3ème niveau défectueux

Salut, et bienvenu sur ce Forum
pour la validation de donnees dans la colonne D c'est normal qu'il n'affiche rien puisque la plage nommee "Choix3" ne contient aucun element.
tu dois revenir avec une explication tres precise en marquant le resultat souhaite sur ton fichier.

@+
Rachid

Edit : Salut Boisgontier

 

[Jahvik]

Re : Liste déroulante - 3ème niveau défectueux

Bonjour @BOISGONTIER,

Merci de tout coeur pour votre aide. Votre fichier initial m'a énormément aidé ! Par simple curiosité, pourriez-vous m'expliquer quelle modification avez-vous effectué (je n'arrive pas à voir la modification faite sur le code VBA) ? Merci encore pour votre remarquable travail.

Bonjour @Rachid_0661,

Je souhaitais faire apparaître les données de la colonne C ("Denomination") de la feuille "Listing" en fonction de mon choix précédent ("Marque"). Merci pour votre contribution.

 

[BOISGONTIER]

Re : Liste déroulante - 3ème niveau défectueux

Le code n'a pas été modifié. Ce sont les menus déroulants qui ont été déplacés.
Si les menus ne sont pas déplacés, le code devient:

'Ecriture des choix effectués et des choix à proposer (on selection)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = True 'False
    Set f = Sheets("Listing")
    If Not Intersect([B8:B2000], Target) Is Nothing And Target.Count = 1 Then 'Choix1 Type
        f.[u2] = Empty
        f.[A1:A2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:u2], CopyToRange:=f.[k1], Unique:=True
    End If
    If Not Intersect([C8:C2000], Target) Is Nothing And Target.Count = 1 Then 'Choix2 Marque
        f.[u2] = Target.Offset(0, -1)
        f.[v2] = Empty
        f.[A1:B2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:v2], CopyToRange:=f.[l1], Unique:=True
    End If
    If Not Intersect([D8:D2000], Target) Is Nothing And Target.Count = 1 Then 'Choix3 Dénomination
        f.[u2] = Target.Offset(0, -2)
        f.[v2] = Target.Offset(0, -1)
        f.[w2] = Empty
        f.[A1:C2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:w2], CopyToRange:=f.[m1], Unique:=True
    End If
    If Not Intersect([E8:E2000], Target) Is Nothing And Target.Count = 1 Then 'Choix4 Couleur
        f.[u2] = Target.Offset(0, -3)
        f.[v2] = Target.Offset(0, -2)
        f.[w2] = Target.Offset(0, -1)
        f.[x2] = Empty
        f.[A1:D2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:x2], CopyToRange:=f.[n1], Unique:=True
    End If
    If Not Intersect([F8:F2000], Target) Is Nothing And Target.Count = 1 Then 'Choix5 Waterproof
        f.[u2] = Target.Offset(0, -4)
        f.[v2] = Target.Offset(0, -3)
        f.[w2] = Target.Offset(0, -2)
        f.[x2] = Target.Offset(0, -1)
        f.[y2] = Empty
        f.[A1:E2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:y2], CopyToRange:=f.[o1], Unique:=True
    End If
    If Not Intersect([G8:G2000], Target) Is Nothing And Target.Count = 1 Then 'Choix6 Prix
        f.[u2] = Target.Offset(0, -5)
        f.[v2] = Target.Offset(0, -4)
        f.[w2] = Target.Offset(0, -3)
        f.[x2] = Target.Offset(0, -2)
        f.[y2] = Target.Offset(0, -1)
        f.[z2] = Empty
        f.[A1:F2000].AdvancedFilter Action:=xlFilterCopy, criteriaRange:=f.[u1:z2], CopyToRange:=f.[p1], Unique:=True
    End If
End Sub

JB

 

[Jahvik]

Merci beaucoup pour votre aide (et au passage pour votre très bon site Internet). Je peux placer le problème en résolu ! Bonne journée !