XL 2019 Saisie semi-automatique par mots clés Excel

L

Laurie21700

XLDnaute Nouveau
Bonjour à tous 👋

Malgré de nombreuses heures à chercher des solutions sur des vidéos YouTube avec mon faible niveau en Excel, je jette l’éponge !

Peut-être quelqu’un aurait la solution à mon problème sur ce forum :)

Voilà… j’ai un tableau Excel avec une liste client. Chaque client à un numéro.

J’aimerai qu’en saisissant un mot clé du nom ou prénom du client, exemple : « Cach » pour Lise Cacheux, ça me propose ce client et que dans une autre colonne son numéro de client s’affiche.

Actuellement j’ai juste une liste déroulante où je peux faire juste une recherche avec la 1ère lettre. Mais ayant de nombreux clients, il me faudrait une recherche semi-automatique par « contient » et non « commence par »

J’ai déjà mon tableau de crée. Est-ce que quelqu’un pourrait m’aider pour la création de ces formules svp ?

Je vous joindrais mon tableau.

Merci beaucoup pour votre aide.
Laurie
 
Trier par date Trier par votes
Etoto

Etoto

XLDnaute Barbatruc
Laurie21700 à dit:
Il y a pour certains clients que ça ne fonctionne pas : Anne Jarry, Coralie Rebai et je pense d'autres aussi du coup. Etrange
Cliquez pour agrandir...
Quoi ? Tout fonctionne pour moi :
WhatsApp Image 2022-03-03 at 09.34.14.jpeg


Photo faite avec mon téléphone car l'application capture ne veut pas montrer le liste déroulante 😅

Et Coralie Rebai fonctionne aussi pour moi. Tu utilises qu'elles étapes ?
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Laurie21700, le fil,

Une solution VBA dans le fichier joint.

Elle nécessite d'avoir une ComboBox dans chaque feuille de mois.

Le code dans ThisWorkbook :
VB: 
Dim CB(0) As New Classe1 'mémorise le tableau

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set Target = Intersect(Target.EntireRow, Sh.Range("F2:G" & Sh.Rows.Count), Sh.UsedRange.EntireRow)
If Target Is Nothing Then Exit Sub
Dim d As Object, dd As Object, tablo, i&, col%
'---listes des paniers et des clients---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
dd.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = tablo(i, 2)
    dd(tablo(i, 2)) = tablo(i, 1)
Next i
'---recherches des paniers et des clients---
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target.Areas 'si entrées multiples (copier-coller)
    tablo = Target 'matrice, plus rapide
    col = ActiveCell.Column
    For i = 1 To UBound(tablo)
        If col = 6 Then
            If d.exists(tablo(i, 1)) Then tablo(i, 2) = d(tablo(i, 1))
        Else
            If dd.exists(tablo(i, 2)) Then tablo(i, 1) = dd(tablo(i, 2))
        End If
    Next i
    Target = tablo 'restitution
Next Target
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set CB(0).CB = Sh.OLEObjects("ComboBox1").Object 'initialise la classe
With CB(0).CB
    .Visible = False
    If Intersect(ActiveCell, Sh.Range("G2:G" & Sh.Rows.Count)) Is Nothing Then Exit Sub
    .Left = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = ActiveCell.Width
    .Height = 16
    .Visible = True
    .Activate
    .Text = Chr(1)
    .Text = "" 'crée la liste
End With
End Sub
Le code dans le module de classe :
VB: 
Public WithEvents CB As MSForms.ComboBox

Private Sub CB_Change()
Dim txt$, tablo, i&, liste(), n&
txt = "*" & LCase(CB) & "*"
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2)
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 2)) Like txt Then
        ReDim Preserve liste(n)
        liste(n) = tablo(i, 2)
        n = n + 1
    End If
Next i
If n Then CB.List = liste Else CB.List = Array("")
CB.DropDown
End Sub

Private Sub CB_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
ActiveCell = CB.Text
ActiveCell(1, 0).Select
End Sub
Il permet une recherche intuitive avec la ComboBox, le mode d'emploi est indiqué.

Nota : j'ai supprimé une colonne inutile dans la feuille "Liste Clients".

A+
 

Pièces jointes

  • Tableau clients(1).xlsm
    670.3 KB · Affichages: 16
Vote positif 0 Vote négatif
Etoto

Etoto

XLDnaute Barbatruc
job75 à dit:
Bonjour Laurie21700, le fil,

Une solution VBA dans le fichier joint.

Elle nécessite d'avoir une ComboBox dans chaque feuille de mois.

Le code dans ThisWorkbook :
VB: 
Dim CB(0) As New Classe1 'mémorise le tableau

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set Target = Intersect(Target.EntireRow, Sh.Range("F2:G" & Sh.Rows.Count), Sh.UsedRange.EntireRow)
If Target Is Nothing Then Exit Sub
Dim d As Object, dd As Object, tablo, i&, col%
'---listes des paniers et des clients---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
dd.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = tablo(i, 2)
    dd(tablo(i, 2)) = tablo(i, 1)
Next i
'---recherches des paniers et des clients---
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target.Areas 'si entrées multiples (copier-coller)
    tablo = Target 'matrice, plus rapide
    col = ActiveCell.Column
    For i = 1 To UBound(tablo)
        If col = 6 Then
            If d.exists(tablo(i, 1)) Then tablo(i, 2) = d(tablo(i, 1))
        Else
            If dd.exists(tablo(i, 2)) Then tablo(i, 1) = dd(tablo(i, 2))
        End If
    Next i
    Target = tablo 'restitution
Next Target
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set CB(0).CB = Sh.OLEObjects("ComboBox1").Object 'initialise la classe
With CB(0).CB
    .Visible = False
    If Intersect(ActiveCell, Sh.Range("G2:G" & Sh.Rows.Count)) Is Nothing Then Exit Sub
    .Left = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = ActiveCell.Width
    .Height = 16
    .Visible = True
    .Activate
    .Text = Chr(1)
    .Text = "" 'crée la liste
End With
End Sub
Le code dans le module de classe :
VB: 
Public WithEvents CB As MSForms.ComboBox

Private Sub CB_Change()
Dim txt$, tablo, i&, liste(), n&
txt = "*" & LCase(CB) & "*"
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2)
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 2)) Like txt Then
        ReDim Preserve liste(n)
        liste(n) = tablo(i, 2)
        n = n + 1
    End If
Next i
If n Then CB.List = liste Else CB.List = Array("")
CB.DropDown
End Sub

Private Sub CB_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
ActiveCell = CB.Text
ActiveCell(1, 0).Select
End Sub
Il permet une recherche intuitive avec la ComboBox, le mode d'emploi est indiqué.

Nota : j'ai supprimé une colonne inutile dans la feuille "Liste Clients".

A+
Cliquez pour agrandir...
Trop bien ton code, merci ! 😁
 
Vote positif 0 Vote négatif
Etoto

Etoto

XLDnaute Barbatruc
job75 à dit:
Bonjour Laurie21700, le fil,

Une solution VBA dans le fichier joint.

Elle nécessite d'avoir une ComboBox dans chaque feuille de mois.

Le code dans ThisWorkbook :
VB: 
Dim CB(0) As New Classe1 'mémorise le tableau

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set Target = Intersect(Target.EntireRow, Sh.Range("F2:G" & Sh.Rows.Count), Sh.UsedRange.EntireRow)
If Target Is Nothing Then Exit Sub
Dim d As Object, dd As Object, tablo, i&, col%
'---listes des paniers et des clients---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
dd.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    d(tablo(i, 1)) = tablo(i, 2)
    dd(tablo(i, 2)) = tablo(i, 1)
Next i
'---recherches des paniers et des clients---
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target.Areas 'si entrées multiples (copier-coller)
    tablo = Target 'matrice, plus rapide
    col = ActiveCell.Column
    For i = 1 To UBound(tablo)
        If col = 6 Then
            If d.exists(tablo(i, 1)) Then tablo(i, 2) = d(tablo(i, 1))
        Else
            If dd.exists(tablo(i, 2)) Then tablo(i, 1) = dd(tablo(i, 2))
        End If
    Next i
    Target = tablo 'restitution
Next Target
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set CB(0).CB = Sh.OLEObjects("ComboBox1").Object 'initialise la classe
With CB(0).CB
    .Visible = False
    If Intersect(ActiveCell, Sh.Range("G2:G" & Sh.Rows.Count)) Is Nothing Then Exit Sub
    .Left = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = ActiveCell.Width
    .Height = 16
    .Visible = True
    .Activate
    .Text = Chr(1)
    .Text = "" 'crée la liste
End With
End Sub
Le code dans le module de classe :
VB: 
Public WithEvents CB As MSForms.ComboBox

Private Sub CB_Change()
Dim txt$, tablo, i&, liste(), n&
txt = "*" & LCase(CB) & "*"
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2)
For i = 1 To UBound(tablo)
    If LCase(tablo(i, 2)) Like txt Then
        ReDim Preserve liste(n)
        liste(n) = tablo(i, 2)
        n = n + 1
    End If
Next i
If n Then CB.List = liste Else CB.List = Array("")
CB.DropDown
End Sub

Private Sub CB_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
ActiveCell = CB.Text
ActiveCell(1, 0).Select
End Sub
Il permet une recherche intuitive avec la ComboBox, le mode d'emploi est indiqué.

Nota : j'ai supprimé une colonne inutile dans la feuille "Liste Clients".

A+
Cliquez pour agrandir...
Juste une question, ta liste fonctionne vraiment bien mais je n'arrive pas à faire que si on sélectionne le nom, il soit validé. Comment on valide un nom avec ta méthode ? (Je parie que je me suis loupé avec un truc tout c**).
 
Vote positif 0 Vote négatif
M

Marie-C

XLDnaute Nouveau
Bonjour à tous,
j'ai suivi avec intérêt les réponses à la question de Laurie21770 mais je vois que cela ne fonctionne que pur les 1ères lettres du mot recherché. J'ai un fichier de produits en liste déroule et pour gagner du temps, je voudrais juste taper un mot qui se trouve sur cette liste mais pas forcément au début.
Je ne sais pas si je me fais bien comprendre.
Merci pour votre aide
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
Microsoft 365 Liste derourante avec saisie semi automatique
Réponses
6
Affichages
639
Anto92
A
C
  • Question
XL 2021 Excel facturation avec BD clients (modèle utilisable joint) - liste déroulante =INDIRECT sur classeur séparé
Réponses
12
Affichages
350
Calizarine
C
L
  • Question
XL 2021 Formulaire de saisie VBA
Réponses
6
Affichages
752
youky(BJ)
youky(BJ)
D
  • Question
Microsoft 365 Saisie semi automatique sur liste déroulante
2
Réponses
15
Affichages
1 K
damien.mangin88
D
S
  • Question
XL 2013 recherche intuitif semi automatique dans Combobox (trié et avec valeur unique) inseré en UserForm VBA
2
Réponses
18
Affichages
424
Sghaier Chafaa
S
alexandre33260
  • Résolu(e)
XL 2021 Copie cellules Excel vers Word avec mise à jour automatique
2
Réponses
29
Affichages
693
alexandre33260
alexandre33260
R
  • Résolu(e)
Microsoft 365 dans un tableau, saisie semi automatique sur liste
2
Réponses
17
Affichages
918
rafi93
R
C
  • Résolu(e)
Microsoft 365 recherche par mots clés dans plusieurs feuilles à partir d'un userform
Réponses
10
Affichages
908
CALIE
C
L
  • Question
XL 2019 Trouver la data correspondant selon un tableau ; deux colonnes et une ligne.
2 3 4
Réponses
54
Affichages
2 K
job75
job75
D
  • Question
XL 2016 Liste déroulante semi automatique
Réponses
3
Affichages
712
Deadpool_CC
Deadpool_CC

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 124 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16