Microsoft 365 Excel : liste

[VBA_dev_Anne_Marie]

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.

 

[job75]

Bonsoir VBA_dev_Anne_Marie,

Voyez le fichier joint et cette macro dans le code de la feuille "Liste" :

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+

 

[VBA_dev_Anne_Marie]

Bonsoir VBA_dev_Anne_Marie,

Voyez le fichier joint et cette macro dans le code de la feuille "Liste" :

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]

Bonjour @ tous,
Salut Job75,

Voir PJ

Cordialement

 

[R@chid]

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

 

[job75]

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 :

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+

 

[job75]

Dans ce fichier (3) en feuille "Base" le tableau source est structuré :

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

 

[sylvanu]

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 :

=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.

 

[job75]

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 :

Target.Validation.Add xlValidateList, Formula1:=Join(Application.Transpose([Liste]), ",") 'crée la liste en dur

 

[VBA_dev_Anne_Marie]

Merci beaucoup !