XL 2019 liste en cascade : un nom pour plusieurs prénoms

[pat66]

Bonjour le forum,

J'ai une liste de noms et de prénoms, jusque là tout va bien, j'arrive à extraire, mais cela se complique lorsque il y a plusieurs prénoms pour un même nom

je suis aller faire un tour sur l'excellent site de http://boisgontierj.free.fr/, mais il faudrait adapter ses exemples, sans succès c'est trop compliqué pour moi, alors je fais appel à vos compétences et comme une image vaut dix mille mots j'ai joints un petit exemple

merci

Pat66

 

[job75]

Bonjour pat66,

Tout dépend de ce que vous entendez par "afficher en cascade", voyez le fichier joint.

A+

 

[job75]

Autre solution.

 

[pat66]

Bonjour Job,
effectivement cela mérite une précision, en cascade mais dans la même cellule

merci

 

[pat66]

Job

oui le post #3 corrrespond mais ce serait parfait si la liste s'affichait instantanément sans avoir à cliquer sur la petite flèche ou alors que la cellule du prénom se vide pour aller choisir le bon prénom
en tout cas votre formule est top =DECALER($M$9;;;NB.SI($M:$M;"><"))

 

[job75]

Evidemment avec le VBA on fait ce qu'on veut, fichier (3) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nom$, tablo, i&, liste$
nom = LCase([E5]) 'minuscules
If nom <> "" Then
    tablo = [Tableau1] 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If LCase(tablo(i, 1)) = nom Then liste = liste & vbLf & Application.Proper(tablo(i, 2)) 'nom propre
    Next
End If
Application.EnableEvents = False 'désactive les évènements
With [E9]
    .WrapText = True 'renvoi à la ligne
    .Value = Mid(liste, 2) 'restitution
    .EntireRow.AutoFit 'ajustement hauteur
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

 

[pat66]

re,

oui effectivement, mais au lieu d'afficher tous les prénoms, pourriez vous faire en sorte qu'ils s'affichent mais que je puisse choisir celui à conserver comme une sorte de liste déroulante

merci

 

[job75]

Dans une cellule ce n'est pas possible, il faut une ListBox, nombreux exemples sur XLD.

 

[youky(BJ)]

Bonjour le fil et à tous
Comme dit Job voici avec une listbox
Sur selection du prénom . . .
Bruno

 

[pat66]

Bonsoir

et avec ca adapté ce serait possible
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Target.Offset(0, 1) = Empty
n = Application.CountIf([CP], Target)
Select Case n
Case 1
Target.Offset(0, 1) = [CP].Find(Target, LookAt:=xlWhole).Offset(0, 1)
Case Is > 1
Target.Offset(0, 1).Select
SendKeys "%{down}"
End Select
End If

 

[job75]

Bonjour pat66, Bruno, le forum,,

Oui une ListBox dans un UserForm ce n'est pas fameux, il faudrait au moins la mettre dans la feuille.

Mais il vaut bien mieux piloter une liste de validation avec cette macro du fichier (4) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim celnom As Range, celprenom As Range, nom$, tablo, i&, liste$
Set celnom = [E5] 'à adapter
Set celprenom = [E9] 'à adapter
If Intersect(Target, Union(celnom, celprenom)) Is Nothing Then Exit Sub
If Target.Address = celnom.Address Then Target.Select
nom = LCase(celnom) 'minuscules
If nom <> "" Then
    tablo = [Tableau1] 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If LCase(tablo(i, 1)) = nom Then liste = liste & "," & Application.Proper(tablo(i, 2)) 'nom propre
    Next
End If
liste = Mid(liste, 2)
Application.EnableEvents = False 'désactive les évènements
With celprenom
    If InStr(liste, ",") Then 'au moins 2 prénoms
        If ActiveCell.Address <> .Address Or .Value = "" Then
            .Select
            .Value = ""
            .Validation.Delete
            .Validation.Add xlValidateList, Formula1:=liste
            CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
         End If
    Else '0 ou 1 prénom
        .Validation.Delete
        .Value = liste
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Notez que pour dérouler la liste avec SendKeys il faut utiliser l'objet WScript.Shell.

Cela évite de désactiver le pavé numérique.

A+

 

[pat66]

Bonjour Job75, Youky, le forum,

Je sais pas pourquoi mais je savais que vous trouveriez, encore une fois la solution Job, c'est exactement ce qu'il me fallait

je pense sincèrement qu'excel n'a aucun secret pour vous, vous êtes très compétent et grâce à votre générosité pour des gens passionnés d'excel comme moi, nous pouvons nous amuser en apprenant

un grand merci à vous et à Youky

Pat66

 

[pat66]

re,

juste un détail mais qui a son importance, pourrait t'on supprimer la majuscule des prénoms car je les écris en minuscule mais s'affichent avec la majuscule

merci Job75

 

[pat66]

re,

j'ai trouvé tout seul comme un grand en décortiquant votre macro :
Application.Proper(tablo(i, 2)) 'nom propre en commentaire
x = Application.Proper("texte")
x = UCase("texte")
x = LCase("TEXTE")

merci pour tout encore

Pat66