Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

pat66

XLDnaute Impliqué
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
 

Pièces jointes

  • NomPrenoms.xlsm
    11.3 KB · Affichages: 15
Dernière édition:
Solution
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) :
VB:
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 & "," &...

pat66

XLDnaute Impliqué
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;"><"))
 
Dernière édition:

job75

XLDnaute Barbatruc
Evidemment avec le VBA on fait ce qu'on veut, fichier (3) :
VB:
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
 

Pièces jointes

  • NomPrenoms(3).xlsm
    20.1 KB · Affichages: 9

pat66

XLDnaute Impliqué
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
 
Dernière édition:

pat66

XLDnaute Impliqué
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

XLDnaute Barbatruc
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) :
VB:
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+
 

Pièces jointes

  • NomPrenoms(4).xlsm
    21.5 KB · Affichages: 7
Dernière édition:

pat66

XLDnaute Impliqué
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

XLDnaute Impliqué
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
 
Dernière édition:

pat66

XLDnaute Impliqué
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…