Microsoft 365 Excel : liste

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Bonjour,

Je souhaite créer une liste avec une présélection des données suite à la première lettre saisie.
J'applique une formule dans la cellule B2 (l'onglet "Base", le fichier est ci-joint), mais elle marche juste pour la sélection sur la première ligne de l'onglet "Liste".
J'aimerais bien, en fait, sur l'onglet "Liste", avoir la présélection sur la ligne 2, 3 etc. en saisissant la première lettre de prénom.


Merci beaucoup pour votre aide.
 

Pièces jointes

  • Liste.xlsx
    27.9 KB · Affichages: 8

job75

XLDnaute Barbatruc
Bonsoir VBA_dev_Anne_Marie,

Voyez le fichier joint et cette macro dans le code de la feuille "Liste" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Or Target.Column > 1 Then Exit Sub
Target.Select
Target.Validation.Delete 'RAZ
If Target = "" Then Exit Sub
Dim cible$, L%, tablo, i&, x$, n&
cible = LCase(Target)
L = Len(cible)
With Sheets("Base")
    .Columns(3).ClearContents
    tablo = .Columns("A:B") 'matrice, plus rapise, au moins 2 éléments
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If LCase(Left(x, L)) = cible Then
            n = n + 1
            tablo(n, 1) = x
        End If
    Next
    If n = 0 Then Exit Sub
    .[C1].Resize(n) = tablo
    .[C1].Resize(n).Name = "Liste" 'plage nommée
End With
Target.Validation.Add xlValidateList, Formula1:="=Liste"
Target.Validation.ShowError = False
If Application.CountIf([liste], cible) = 0 Then CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
End Sub
Entrez en colonne A la ou les 1ères lettres du prénom recherché.

A+
 

Pièces jointes

  • Liste(1).xlsm
    34.4 KB · Affichages: 4

VBA_dev_Anne_Marie

XLDnaute Occasionnel
Bonsoir VBA_dev_Anne_Marie,

Voyez le fichier joint et cette macro dans le code de la feuille "Liste" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Or Target.Column > 1 Then Exit Sub
Target.Select
Target.Validation.Delete 'RAZ
If Target = "" Then Exit Sub
Dim cible$, L%, tablo, i&, x$, n&
cible = LCase(Target)
L = Len(cible)
With Sheets("Base")
    .Columns(3).ClearContents
    tablo = .Columns("A:B") 'matrice, plus rapise, au moins 2 éléments
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If LCase(Left(x, L)) = cible Then
            n = n + 1
            tablo(n, 1) = x
        End If
    Next
    If n = 0 Then Exit Sub
    .[C1].Resize(n) = tablo
    .[C1].Resize(n).Name = "Liste" 'plage nommée
End With
Target.Validation.Add xlValidateList, Formula1:="=Liste"
Target.Validation.ShowError = False
If Application.CountIf([liste], cible) = 0 Then CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'déroule la liste
End Sub
Entrez en colonne A la ou les 1ères lettres du prénom recherché.

A+
Merci beaucoup ! Faut que je passe par VBA, on ne peut pas appliquer une formule Excel ?
 

R@chid

XLDnaute Barbatruc
Re,
Bonjour @ tous,
Salut Job75,

Voir PJ

Cordialement
A noter que si vous possédez la dernière mise à jour de Microsoft 365 vous n'aurez pas besoin du travail colossal que j'ai effectué sur mon fichier, puisque cette fonction a été prise en considération par l'équipe de Microsoft depuis quelques mois sauf qu'Excel ne trie pas les prénoms par ordre alphabétique.

Cordialement
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour R@chid, le forum,

Je ne peux pas tester ta solution car elle utilise des fonctions qui n'existent pas sur Excel 2019.

Dans ce fichier (2) j'ai amélioré le code :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Or Target.Column > 1 Then Exit Sub
Target.Select
Target.Validation.Delete 'RAZ
If Target = "" Then Exit Sub
Dim cible$, L%, tablo, i&, x$, n&
cible = LCase(Target)
L = Len(cible)
With Sheets("Base")
    .Columns(3).ClearContents
    tablo = .Range("A1:B" & .Range("A" & .Rows.Count).End(xlUp).Row) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If LCase(Left(x, L)) = cible Then
            n = n + 1
            tablo(n, 1) = x
        End If
    Next
    If n = 0 Then Exit Sub
    .[C1].Resize(n).Name = "Liste" 'plage nommée
    [Liste] = tablo
    [Liste].Sort [Liste], xlAscending, Header:=xlNo 'tri alphabétique
End With
Target.Validation.Add xlValidateList, Formula1:="=Liste"
Target.Validation.ShowError = False
If Application.CountIf([Liste], cible) Then Target.Validation.Delete Else _
    CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'supprime la liste ou la déroule
End Sub
La liste de validation est triée et elle est supprimée une fois qu'on y a choisi un élément.

A+
 

Pièces jointes

  • Liste(2).xlsm
    35.6 KB · Affichages: 0

job75

XLDnaute Barbatruc
Dans ce fichier (3) en feuille "Base" le tableau source est structuré :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Or Target.Column > 1 Then Exit Sub
Target.Select
Target.Validation.Delete 'RAZ
If Target = "" Then Exit Sub
Dim cible$, L%, tablo, i&, x$, n&
cible = LCase(Target)
L = Len(cible)
With [Tableau1].ListObject.Range 'tableau structuré
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(3).EntireColumn.ClearContents 'RAZ
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If LCase(Left(x, L)) = cible Then
            n = n + 1
            tablo(n, 1) = x
        End If
    Next
    If n = 0 Then Exit Sub
    .Cells(1, 3).Resize(n).Name = "Liste" 'plage nommée
End With
[Liste] = tablo
[Liste].Sort [Liste], xlAscending, Header:=xlNo 'tri alphabétique
Target.Validation.Add xlValidateList, Formula1:="=Liste"
Target.Validation.ShowError = False
If Application.CountIf([Liste], cible) Then Target.Validation.Delete Else _
    CreateObject("WScript.Shell").SendKeys "%{DOWN}" 'supprime la liste ou la déroule
End Sub
 

Pièces jointes

  • Liste(3).xlsm
    36.6 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour VBA_dev_Anne_Marie, Job, R@chid,
Faut que je passe par VBA, on ne peut pas appliquer une formule Excel ?
En PJ une solution en formule avec comme liste déroulante :
VB:
=DECALER(Liste;EQUIV($A4&"*"; Liste;0)-1;;NB.SI(Liste;$A4&"*"))
Attention, la liste des prénoms doit être triée par ordre alphabétique.
 

Pièces jointes

  • Liste (2).xlsx
    19.7 KB · Affichages: 5

job75

XLDnaute Barbatruc
Les solutions VBA précédentes ont un défaut : après qu'une liste de validation a été créée; si on ne l'utilise pas, elle n'est plus valable quand on en crée une autre différente.

Pour y remédier il faut créer la liste en dur avec la fonction Join :
VB:
Target.Validation.Add xlValidateList, Formula1:=Join(Application.Transpose([Liste]), ",") 'crée la liste en dur
 

Pièces jointes

  • Liste(4).xlsm
    36.9 KB · Affichages: 2

Discussions similaires

Réponses
12
Affichages
350
Réponses
5
Affichages
164

Statistiques des forums

Discussions
313 309
Messages
2 097 031
Membres
106 812
dernier inscrit
Excellou74