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

job75

XLDnaute Barbatruc

• 4 Avril 2021

• #2

Bonjour pat66,

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

A+

 

Pièces jointes

• NomPrenoms(1).xlsm

  13.2 KB · Affichages: 6

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 4 Avril 2021

• #3

Autre solution.

 

Pièces jointes

• NomPrenoms(2).xlsm

  13.4 KB · Affichages: 9

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 4 Avril 2021

• #4

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

merci

 

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 4 Avril 2021

• #5

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: 4 Avril 2021

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 4 Avril 2021

• #6

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

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 4 Avril 2021

• #7

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: 4 Avril 2021

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 4 Avril 2021

• #8

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

 

Vote positif 0 Vote négatif

youky(BJ)

XLDnaute Barbatruc

• 4 Avril 2021

• #9

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

 

Pièces jointes

• NomPrenoms.xlsm

  21.2 KB · Affichages: 8

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 4 Avril 2021

• #10

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

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 5 Avril 2021

• #11

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: 5 Avril 2021

Vote positif 0 Vote négatif

Solution

P

pat66

XLDnaute Impliqué

• 5 Avril 2021

• #12

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

 

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 5 Avril 2021

• #13

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: 5 Avril 2021

Vote positif 0 Vote négatif

P

pat66

XLDnaute Impliqué

• 5 Avril 2021

• #14

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

 

Vote positif 0 Vote négatif