Microsoft 365 [VBA] Liste déroulante en cascade avec affichage de la 1ère référence trouvée

[ralph45]

Bonjour le Forum et tout le monde en cette fin d'année,
Je souhaite que vous-mêmes ainsi que vos proches viviez la nouvelle avec tous mes vœux de santé, réussite et de bonheur.

Dans le fichier joint et l'onglet "CHOIX", j'aimerai faire afficher la première référence trouvée selon la sélection de la liste déroulante 1 (LD1).
J'ai essayé de générer une LD1 triée sans doublon, mais elle ne me semble pas au point, en regard de ma base réelle (avec plus de 1.500 références)
Il faudrait par la suite améliorer le code de @job75 () pour arrêter le défilement, selon toujours le choix de la LD1

En exemple, en sélectionnant "BORDEAUX" dans la LD1 de la cellule B3, je veux qu'en B6, apparaisse le numéro de produit "202456".

 

[job75]

Bonjour ralph45,

Ce n'est pas le bon fichier : pas d'onglet "CHOIX" ni de "BORDEAUX".

A+

 

[ralph45]

Bonjour @job75 ,

Ah là là, ma tête me joue des tours.
Voici le bon fichier...

 

[job75]

Bonjour ralph45, le forum,

Voyez le fichier joint et ces macros dans le code de la feuille "CHOIX" :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B3]) Is Nothing Then Exit Sub
With Sheets("A MASQUER")
    .Columns("A:B").Clear 'RAZ
    Sheets("LISTE").UsedRange.Columns(1).Copy .[A1]
    .Columns(1).Sort .[A1], xlAscending, Header:=xlYes 'tri alphabétique
    .Columns(1).RemoveDuplicates 1, xlYes 'supprime les doublons
    [B3].Validation.Delete 'RAZ
    [B3] = ""
    With .[A1].CurrentRegion
        If .Count > 1 Then
            .Offset(1).Resize(.Count - 1).Name = "VILLES" 'plage nommée
            [B3].Validation.Add xlValidateList, Formula1:="=VILLES"
            CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
        End If
    End With
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'désactive les évènements
With Sheets("A MASQUER")
    .Columns("B:D").Clear 'RAZ
    Sheets("LISTE").UsedRange.AutoFilter 1, [B3]
    Sheets("LISTE").UsedRange.Columns(2).Copy .[C1]
    Sheets("LISTE").UsedRange.AutoFilter
    .Columns(3).RemoveDuplicates 1, xlYes 'au cas où...
    [B6].Validation.Delete 'RAZ
    [B6] = ""
    With .[C1].CurrentRegion
        If .Count > 1 Then
            .Offset(1).Resize(.Count - 1).Name = "PRODUITS" 'plage nommée
            [B6].Validation.Add xlValidateList, Formula1:="=PRODUITS"
            [B6] = [PRODUITS].Cells(1)
        Else
            ThisWorkbook.Names.Add "PRODUITS", "=#N/A"
        End If
    End With
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub Suivant()
Dim c As Range, R As Range, n&
If IsError([PRODUITS]) Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
Set c = [B6]
Set R = [PRODUITS]
If c <> "" Then n = Application.Match(c, R, 0): If n < R.Count Then c = R(n + 1)
If n >= R.Count - 1 Then MsgBox "Vous êtes arrivé en fin de liste"
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

[ralph45]

Bonjour @job75,

Sur le fichier exemple, tout fonctionne à merveille, mais les codes une fois transposés dans mon fichier réel ne fonctionnent pas (je suis en phase d'adaptation). Wait & See.

Merci beaucoup pour cette aide...

 

[ralph45]

Re @job75

Je viens d'adapter ce code dans mon fichier réel et tout se passe quasiment bien.

1° … Exceptée une interrogation de taille : la deuxième liste déroulante commence bien avec la première référence trouvée, certes, mais elle ne me laisse pas choix de sélectionner un produit de cette liste ?
--> Lorsque je sélectionne un produit, celui est automatiquement effacé et remplacé par le premier de la liste…

2° Je voudrai que le message "Vous êtes arrivé en fin de liste" se génère après avoir cliqué sur le bouton "Suivant" du dernier produit afférent à la ville et non à l'affichage de ce dernier.

 

[job75]

Voyez ce fichier (2), pour le 1° j'ai ajouté dans la macro Worksheet_Change :

If Target.Address = "$B$6" Then Exit Sub

et pour le 2° dans la macro Suivant :

If c <> "" Then n = Application.Match(c, R, 0): If n < R.Count Then _
    c = R(n + 1) Else MsgBox "Vous êtes arrivé en fin de liste"

Dans cette macro les Application.EnableEvents ne sont plus nécessaires.

 

[ralph45]

Bonjour le Forum et @job75

Merci de votre rapidité et efficacité.

a) Pour le point N°2, c'est nickel

b) Mais j'ai toujours un souci avec le point N°1 : dans mon fichier réel, je dois sur chaque produit renseigner des informations du type oui/non ou des valeurs texte/numérique (c'est une sorte d'inventaire).

Alors le code mis plus haut fonctionne très bien…

If Target.Address = "$B$6" Then Exit Sub

... mais il faudrait que je le démultiplie par autant de cellules que j'aurai à modifier ?

C'est possible, mais très contraignant, car j'ai une quarantaine de cellules non contiguës à éventuellement modifier, genre :
If Target.Address = "$B$8" Then Exit Sub
If Target.Address = "$B$10" Then Exit Sub
If Target.Address = "$B$12" Then Exit Sub
If Target.Address = "$D$8" Then Exit Sub
etc.

 

[job75]

Bonjour ralph45, le forum,

Joignez un fichier correspondant à ce que vous voulez faire.

A+

 

[ralph45]

Re,

Le hic, c'est que mon fichier réel est très volumineux (même en réduisant la base de références produits, il est de plus de 2 Mo) et que certaines données sont "à la limite" non-compatibles RGPD.
Si je vous détaille les cellules à modifier dans mon fichier-exemple ? Ou peut-être en messagerie privée ?

 

[job75]

La messagerie n'est pas faite pour traiter les problèmes et on ne peut pas joindre de fichier.

Débrouillez-vous pour joindre un fichier allégé et anonymisé, sinon on en restera là.

 

[ralph45]

Moui, je me doutais bien
Je vais à ce moment modifier mon fichier-exemple pour qu'il corresponde au mieux à mon fichier réel, mais cela va me prendre quelques heures et pour en faire le descriptif… Merci dans tous les cas et à bientôt !