Filtrer une listbox sur base de mots saisis dans un textbox

**NulenExcel77** · 14/10/2021, 10h45

Bonjour

L’intitulé est incompréhensible je dirai, désolé, je vais tenter de m'expliquer plus clairement.

Voila, j'ai besoin, pour mon travail, de créer un petit outil pour rechercher une référence (à laide d'un mot clef) dans
une liste de plusieurs millier de lignes.
J'ai trouvé cette macro ici même ,qui fait plus ou moins le travail, et me donne les résultats de ma recherche dans une listbox.
Mon soucis, est qu'il me donne toutes les lignes ou apparait le mot dans l'ensemble de la chaine de caractère.
Par exemple, si je cherche "Lan" tout simplement , la macro ne fera pas la différence avec "Lancer" ou encore "Lana" .
Au début, la macro était associé à l'Event "change" de ma textbox, mais j'ai essayé de le déclencher avec "Enter" pour ainsi avoir le mot
souhaité avant de lancer la recherche, mais rien n'y fait

J'ai essayé par la suite d'associer des espaces avant et après la valeur de la textbox, mais là aussi, rien.

Auriez vous une piste à me proposer svp, je suis dans une impasse là.

Merci infiniment pour le temps que vous voulez bien m'accorder

Voici la macro de base avec laquelle je travaille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
If keycode <> 13 Then Exit Sub
 
If Me.TextBox1 <> "" Then
     '---
     Set d = CreateObject("scripting.dictionary")
     mots = Split(Trim(Me.TextBox1), ",")
     For Each m In mots
       mots2 = Split(Trim(m), " ")
       Tbl = choix
       For i = LBound(mots2) To UBound(mots2)
         Tbl = Filter(Tbl, mots2(i), True, vbTextCompare)
       Next i
       For i = LBound(Tbl) To UBound(Tbl): d(Tbl(i)) = "": Next i
     Next m
     Tbl = d.keys
     '----
     n = UBound(Tbl) + 1
     If n > 0 Then
       ReDim Tbl2(LBound(Tbl) To n + 1, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1: Tbl2(j, k + 1) = a(k): Next k
       Next j
       Me.ListBox1.List = Tbl2
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If

**fraflt69** · 14/10/2021, 11h08

Bonjour NulenExcel77

Merci de fournir toute la procédure et ces sous-procédures, de déclarer les variables (avec une ligne "Option explicit" en tête de module), de fournir un jeu de test (les milliers de lignes en fichier joint) sinon ce sera difficile de t'aider.

Un textbox c'est un objet d'un formulaire issu d'un objet range Excel?
Comment ce textbox est t'il initialisé?
Y aura t'il une boucle avec plusieurs textbox?

Fraflt69

**NulenExcel77** · 14/10/2021, 11h24

Bonjour fraflt69,

Merci de répondre aussi vite

je m'y attendais pas

Je suis aller trop vite semble t'il, lol
Je reformulerai ma demande ce soir avec les éléments que tu me demande

Merci encore et à plus tard.

**Pierre Fauconnier** · 14/10/2021, 12h00

Salut.

Je ne pense pas qu'il soit utile de fournir tout le code pour cela

Normalement, on s'appuie sur un tableau structuré, nommé dans mon exemple Tableau2.

Un simple Application.Match, l'équivalent d'un EQUIV en Excel, permet de rechercher la ligne de l'intitulé saisi dans le textbox:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click()
  Dim Index
 
  Index = Application.Match(TextBox1.Value, Range("tableau2[Intitulé]"), 0)
  If Not IsError(Index) Then
    MsgBox "La ligne du tableau est la ligne " & Index
  Else
    MsgBox "L'intitulé n'a pas été trouvé"
  End If
End Sub

Nom : 2021-10-14_115719.png
Affichages : 526
Taille : 17,6 Ko

A adapter à ton besoin.

A adopter: les tableaux structurés qui vont grandement simplifier ton approche du code.

**NulenExcel77** · 14/10/2021, 23h04

Bonsoir,

Désolé pour cette réponse tardive, j'ai cherché de mon coté, sans y arriver

Merci Pierre Fauconnier de te pencher sur mon problème.
J'ai essayé d'utiliser ta méthode, d'adapter mon code avec mais rien n'y fait

je mérite mon pseudo je crois.

En l'état, mon fichier marche très bien, j'aimerai pouvoir garder cette base.
le seul problème est qu'il recherche la valeur du textbox mème dans les mot plus long.
Je souhaiterai qu'il regarde seulement le mot dans son entier.

Étape par étape, j'ouvre l'USF, la listbox est rempli avec les données que j'ai délimité sur ma feuille XL (tableau2)
je veux filtrer le tout grâce à ma textbox1, un espace pour peaufiner la recherche et valider avec "enter"
je vous joint un fichier, ce sera plus simple, les explications et moi ça fait 15 :/

**jurassic pork** · 15/10/2021, 08h17

hello,
c'est normal qu'avec le code que tu utilises, tu aies ce comportement, et d'ailleurs dans l'étiquette du champ de recherche c'est écrit :

Entrer des mots séparés par un espace et , pour un OU

Il faut enlever la partie qui éclate les mots séparés par des espaces comme ceci par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub TextBox1_keydown(ByVal keycode As MSForms.ReturnInteger, ByVal shift As Integer)
Dim Tbl, Tbl2, m, mots, a
Dim n, k As Integer
Dim d As Object
If keycode <> 13 Then Exit Sub
If Me.TextBox1 <> "" Then
     '---
     Set d = CreateObject("scripting.dictionary")
     mots = Split(Trim(Me.TextBox1), ",")
     For Each m In mots
       Tbl = choix
       Tbl = Filter(Tbl, m, True, vbTextCompare)
       For Each res In Tbl: d(res) = "": Next
     Next m
     Tbl = d.keys
     '----
     n = UBound(Tbl) + 1
     If n > 0 Then
       ReDim Tbl2(LBound(Tbl) To n + 1, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1: Tbl2(j, k + 1) = a(k): Next k
       Next j
       Me.ListBox1.List = Tbl2
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If
End Sub

et puis changer les libellés avec :
1 - Recherche référence grâce à plusieurs expressions
2 - Entrez des expressions séparées par des ,

Ami calmant, J.P

**Pierre Fauconnier** · 15/10/2021, 09h28

Je n'avais manifestement pas compris la demande... Désolé

**fraflt69** · 15/10/2021, 10h38

Bonjour à tous

je me suis lancé dans un filtrage spécifique , à tester
Mon code pour le USF_Recherche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
 
 
Option Compare Text
Dim TblBD(), choix(), NomTableau, NbCol
 
 
 
Private Sub TextBox1_keydown(ByVal keycode As MSForms.ReturnInteger, ByVal shift As Integer)
If keycode <> 13 Then Exit Sub
 
If Me.TextBox1 <> "" Then
     '---
     Set d = CreateObject("scripting.dictionary")
     mots = Split(Trim(Me.TextBox1), ",")
     For Each m In mots
       mots2 = Split(Trim(m), " ")
 
       Tbl = choix
       For i = LBound(mots2) To UBound(mots2)
         Tbl = Filter(Tbl, mots2(i), True, vbTextCompare)
       Next i
       For i = LBound(Tbl) To UBound(Tbl): d(Tbl(i)) = "": Next i
     Next m
     Tbl = d.keys
     '----
     n = UBound(Tbl) + 1
     If n > 0 Then
       ReDim TblInclude(NbCol)
       ReDim Tbl2(LBound(Tbl) To n + 1, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1
          Tbl2(j, k + 1) = a(k)
          If k = 2 And a(k) <> "" Then
            pos = InStr(1, a(k), TextBox1.Text)
            If InStr(1, a(k), TextBox1.Text & " ") Or InStr(1, a(k), TextBox1.Text & ",") Or (InStr(1, a(k), TextBox1.Text) And pos + Len(TextBox1.Text) = Len(a(k))) Then
               TblInclude(j) = 1
               nInclude = nInclude + 1
            End If
          End If
        Next k
       Next j
       Dim Tbl3
       indTab3 = 0
       ReDim Tbl3(LBound(Tbl) To nInclude, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1
            If TblInclude(j) = 1 Then
                Tbl3(indTab3, k + 1) = a(k)
            End If
            If k = NbCol - 1 And TblInclude(j) = 1 Then
              indTab3 = indTab3 + 1
            End If
        Next
       Next
 
       Me.ListBox1.List = Tbl3
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If
End Sub
 
 
 
Private Sub UserForm_Initialize()
 
  NomTableau = "tableau3"
  TblBD = Range(NomTableau).Value
  ReDim choix(1 To UBound(TblBD))
  For i = LBound(TblBD) To UBound(TblBD)
     NbCol = Range(NomTableau).Columns.Count
     For k = 1 To NbCol: choix(i) = choix(i) & TblBD(i, k) & "|": Next k
  Next i
  Me.ListBox1.List = TblBD
  'TblBD.Columns.AutoFit
  EnteteListBox
End Sub
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
'###################### En cours de travaux #########################################
 
 
Sub EnteteListBox()
'Exit Sub
  NbCol = Range(NomTableau).Columns.Count
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To NbCol
    Set Lab = Me.Controls.Add("Forms.Label.1")
 
    If i = 1 Then
    Lab.Caption = "Part number :"
    End If
    If i = 2 Then
    Lab.Caption = ""
 
    End If
    If i = 3 Then
    Lab.Caption = "Déscription :"
    'Lab.Left = x
    x = x + 5
    End If
 
    If i = 5 Then
    Lab.Caption = "Référence :"
    x = x - 285
    End If
 
    If i = 6 Then
    Lab.Caption = "Fabriquant :"
    x = x + 3
 
    End If
 
 
    Lab.Top = Y
    Lab.Left = x
    x = x + Range(NomTableau).Columns(i).Width * 0.9
    temp = temp & Range(NomTableau).Columns(i).Width * 0.9 & ";"
 
  Next
  Me.ListBox1.ColumnCount = NbCol
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
 
  USF_Recherche.ListBox1.ColumnWidths = "80;0;290;0;0;110;0;80"
 
 
End Sub

**NulenExcel77** · 15/10/2021, 11h11

Bonjour,

Merci jurassic pork de t’être penché la dessus

, j'ai intégré ta macro, le filtre se fait bien avec le premier mot
mais avec le second ou un troisième, il reste inchangé ( j'ai bien assuré une séparation avec une ","
ils ne sont pas pris en compte

J'ai regardé vite fait, j'y regarderai de plus prés après le taff

Merci encore pour les efforts.

Merci Pierre Fauconnier, non tkt, c'est moi aussi avec mes explications

par contre, je vais m’intéresser un peu aux tableaux
structurés pour un autre projet

Super, j'ai vu ton message avant de partir, je teste ça ce soir, merci fraflt69

Bonne journée

**Pierre Fauconnier** · 15/10/2021, 11h25

[EDIT] Mis à jour [/EDIT]

Je propose une manière de travailler avec des filtres avancés pilotés en VBA. Ca évite le dictionary, qui n'est pas du VBA pur, et ça évite de coder les critères en dur, ce qui n'est pas forcément simple pour un non programmeur. Ca correspond mieux à mon avis à une démarche Excel, le dictionary et l'expression de critères en VBA étant plus des techniques de "programmeur" que d'utilisateur Excel (vu ton pseudo, en plus, comme tu le dis toi-même

).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then AdaptListBox
End Sub
 
Sub AdaptListBox()
  Dim Words
  Dim i As Long
 
  If Not Range("t_Mots").ListObject.DataBodyRange Is Nothing Then Range("t_Mots").ListObject.DataBodyRange.Delete
  Words = Split(TextBox1.Value, ",")
  If UBound(Words) <> -1 Then
    For i = 0 To UBound(Words)
      Range("t_mots")(i + 1).Value = Words(i)
    Next
  End If
  Feuil1.Range("m1:T" & Feuil1.Range("m1048576").End(xlUp).Row).AdvancedFilter xlFilterCopy, Range("Critère"), Range("résultat")
  ListBox1.List = Feuil5.Range("e2:l" & Feuil5.Range("e1048576").End(xlUp).Row).Value
End Sub

Dans une feuille annexe, on crée la conception du filtre:

un tableau pour récupérer les mots choisis;
une zone de critères formulés pour extraire les données;
une zone de résultats.

J'ai adapté la listbox car c'était un peu foireux sur le nombre de colonnes...

Je répète que normalement, on devrait travailler sur des tableaux structurés, qui grandiront avec l'ajout de données, a contrario de la plage nommée "Tableau3" actuelle. Ca simplifie le code et la maintenance, en évitant notamment le hardcoding de la position des données et les End(xlUP) Idéalement, on nommerait également les feuilles en VBA...

Rappel de ma signature: Quand on programme en VBA pour Excel, on pense Excel avant de penser VBA ;)

Mon tuto sur les tableaux structurés, pour comprendre tout l'intérêt de travailler avec cet outil
Mon billet sur l'extraction grâce au filtre avancé, dans lequel j'explique les avantages de la méthode par rapport à une critérisation "en dur" dans le code

**jurassic pork** · 15/10/2021, 12h17

hello

Envoyé par NulenExcel77

Bonjour,
Merci jurassic pork de t’être penché la dessus

, j'ai intégré ta macro, le filtre se fait bien avec le premier mot
mais avec le second ou un troisième, il reste inchangé ( j'ai bien assuré une séparation avec une ","
ils ne sont pas pris en compte

c'est bizarre parce que chez moi avec une recherche du style :

SMD 1206,SMD 0805

j'obtiens bien deux résultats. Il ne faut pas mettre d'espaces autour de la virgule.
Sinon essaie la solution à Pierre, cela doit être plus fiable.
Ami calmant, J.P

**NulenExcel77** · 15/10/2021, 23h21

Bonsoir les pros,

Désolé jurassic pork, quand ça veut pas

, j'ai bien assuré aucuns espaces autour de la virgule, mais rien.
Est ce que le fait de sauvegarder le fichier en mode "Classeur prenant en charge les macros" est un problème pour la bonne marche du USF??
Je ne sais plus quoi tenter

Pierre, j’avoue n'avoir rien compris à ton fichier :/, ça n'a pas marché chez moi, peu importe le ou les mots du textbox, tout s'efface dans la listbox, ne reste
que l’entête de mon tableau.
Par contre, le truc de passer par XL et ses outils m'interpelle, j'ai survolé tes tutos, et il y a une vérité qui me parle dans ce que j'ai
retenu, tu peux avoir une macro réglé au poil, si ton fichier évolue (ligne/colonne supprimé ou ajouté etc...) bah la macro/l'outil plante.

Avec ton fichier fraflt69, je dirai 99% de ma demande est assuré sauf (bizarrement) avec la recherche "0603", ça plante (et j'ai pas testé avec mes
10000 lignes de données, donc potentiellement, j'ai le doute pour d'autres mot clef

Et il y a aussi, lorsque je met dans le désordre les mots clefs, il ne trouve pas la ligne pourtant existante (499k 0603 il trouve pas alors que 0603 499k, il trouve)
C'est peut être 3x rien, le résultat est presque là

Je continuerai à bidouiller vos codes et idées en attendant

Encore merci pour vos efforts

Bonne soirée

**fraflt69** · 16/10/2021, 07h04

Pardon NulenExcel77

Je crois avoir vu mon erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Il faut changer
     If n > 0 Then
       ReDim TblInclude(NbCol)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
     If n > 0 Then
       ReDim TblInclude(UBound(Tbl))

**NulenExcel77** · 16/10/2021, 10h26

Salut fraflt69,

C'est top, c'est exactement ce que je voulais, mise à part qu'il faille respecter l'ordre des mots dans le textbox,

je m'en fiche un peu, c'est pas trop important

(au pire je laisserai un libellé pour expliquer l'ordre de la saisie

),

le plus gros est là et c'est énorme.Un grand merci à toi

et à tous les autres pour votre réactivité.

Je attendre ce soir pour fermer cette discussion, je vais tourner un peu.

A plus tard

**jurassic pork** · 16/10/2021, 10h28

hello,

Envoyé par NulenExcel77

Voila, j'ai besoin, pour mon travail, de créer un petit outil pour rechercher une référence (à laide d'un mot clef) dans
une liste de plusieurs millier de lignes.

Finalement je crois bien que tu te compliques la vie car avec un filtre personnalisé tu fais la même chose qu'avec ta fenêtre et ta macro.
1 - Sélectionner la zone à filtrer en incluant la ligne d'entête
2 - Cliquer sur l'onglet Données et cliquer sur Filtrer. Des boutons flèches vers le bas apparaissent sur la ligne d'entête. Cliquer sur le bouton de la colonne qui servira à filtrer.
3 - Pour un filtrage simple , mettre dans la barre de recherche le terme à rechercher.
4 - Pour un filtrage plus compliqué, cliquer sur Filtre Textuel/Filtre personnalisé. Remplir alors la fenêtre avec la combinaison des termes à chercher.
5 - Pour enlever le filtre cliquer à nouveau sur Filtrer.
Cela n'altère pas les données c'est seulement un filtre.

Exemple :

Nom : FiltreExcel.gif
Affichages : 489
Taille : 159,4 Ko

Nom : FiltreExcel.gif
Affichages : 489
Taille : 159,4 Ko

Ami calmant, J.P

**NulenExcel77** · 16/10/2021, 22h30

Bonsoir à tous,

Merci jurassik pork, mais ce n'était pas ma demande, ta macro en était très proche.
D’ailleurs je suis toujours penché dessus afin de trouver et comprendre ou ça pèche :/
Le petit outil, sera diffusé à plusieurs services, et il m'est impossible de leur donner accès aux données.
Désolé si ma demande manquait de précision

Il a été décidé de bricoler un outil en interne en lecture seul comme avec un USF et listbox.Une seule personne
est habilitée à créer notre banque de données.
Le classeur sera protégé, l'USF s'ouvrira automatiquement et l’accès à la feuille en arrière plan sera verrouillé
(ou simplement minimisé sur la barre de tache, c'est encore à voir ) et pour finir un double clic copiera la valeur
trouvé pour des actions ultérieurs.

Voila grosso modo son utilité en attendant l'achat d'un vrai ERP et le bon module

encore merci à vous

**jurassic pork** · 17/10/2021, 08h56

hello,

Envoyé par NulenExcel77

Merci jurassik pork, mais ce n'était pas ma demande, ta macro en était très proche.
D’ailleurs je suis toujours penché dessus afin de trouver et comprendre ou ça pèche :/

peux-tu essayer le fichier en pièce jointe en tapant pour la recherche :

SMD 0805,SMD 1206

Si cela ne fonctionne pas --> Quelle version d'Excel utilises-tu ?

Ami calmant, J.P

**fraflt69** · 17/10/2021, 14h03

Bonjour NulEnExcel77

Je me demande s'il ne serait pas possible d'exploiter l'idée de Boisgontier Jacques en faisant une saisie avec completion comme il indique dans la discussion suivante : https://www.developpez.net/forums/d1...bobox-activex/

Cela ajoute une combobox à la textbox
Cela ne permet pas cependant d'accélérer la saisie sur un mot dans un ordre différent.

A toutes fins utiles, pour simplifier l'interface utilisateur

**NulenExcel77** · 17/10/2021, 18h08

Bonjour à tous

Bravo jurassic pork, ça marche bien chez moi.

fraflt69, j'ai suivi le lien, ça m’agace un peu, j'aurai pas dû ouvrir une discussion inutile du coup, mes mots clés étaient foireux :/
Mon outil est opérationnel en l'état pour diffusion, je réfléchi peut être à une optimisation, utiliser le double clic pour un résultat ou un autre,
si vous avez une idée

Comme tu dis, il est intéressant de se pencher sur l'idée de Boisgontier, moi j'adore ça, il est bon d'avoir plusieurs solution sous le coude.
j'y retourne

A plus les pros

bonne fin de journée

**NulenExcel77** · 17/10/2021, 22h43

Bonsoir,

Je reviens vers vous avec un léger souci (j’espère), je m'en suis rendu compte en faisant tester le fichier par quelqu'un
de complétement étranger au service et qui n'est pas de formation technique. (je voulais pousser l’expérience et mettre,
s'il y avait, des défauts en exergue) et malheureusement, c'est gagné

Le problème avec les 2 macros mise au point grâce à votre aide, c'est que la première se comporte exactement comme je
vous l'ai demandé sauf si j'entre les mots-clés dans le désordre ( il trouvera 0603 1k 1% mais pas 1k 1% 0603, listbox vide )

la deuxième, peu importe l'ordre d'entré dans la textbox, il trouvera les résultats avec les mots choisis et même trop de
résultats, il sortira le 0603 1k 1% mais aussi les 1k1 ou les 0.1% etc....

Je voudrais pas abuser, je pourrais simplement ajouter un libellé avec un warning "merci de rentrer les mots dans l'ordre svp"

Merci d'avance pour toutes propositions.

première macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
 
If Me.TextBox1 <> "" Then
     '---
     Set d = CreateObject("scripting.dictionary")
     mots = Split(Trim(Me.TextBox1), ",")
     For Each m In mots
       mots2 = Split(Trim(m), " ")
 
       Tbl = choix
       For i = LBound(mots2) To UBound(mots2)
         Tbl = Filter(Tbl, mots2(i), True, vbTextCompare)
       Next i
       For i = LBound(Tbl) To UBound(Tbl): d(Tbl(i)) = "": Next i
     Next m
     Tbl = d.keys
     '----
     n = UBound(Tbl) + 1
     If n > 0 Then
       ReDim TblInclude(UBound(Tbl))
       ReDim Tbl2(LBound(Tbl) To n + 1, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1
          Tbl2(j, k + 1) = a(k)
          If k = 2 And a(k) <> "" Then
            pos = InStr(1, a(k), TextBox1.Text)
            If InStr(1, a(k), TextBox1.Text & " ") Or InStr(1, a(k), TextBox1.Text & ",") Or _
            (InStr(1, a(k), TextBox1.Text) And pos + Len(TextBox1.Text) = Len(a(k))) Then
               TblInclude(j) = 1
               nInclude = nInclude + 1
            End If
          End If
        Next k
       Next j
       Dim Tbl3
       indTab3 = 0
       ReDim Tbl3(LBound(Tbl) To nInclude, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1
            If TblInclude(j) = 1 Then
                Tbl3(indTab3, k + 1) = a(k)
            End If
            If k = NbCol - 1 And TblInclude(j) = 1 Then
              indTab3 = indTab3 + 1
            End If
        Next
       Next
 
       Me.ListBox1.List = Tbl3
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If
    TextBox1.SetFocus
 
End Sub

et la seconde:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
  If Me.TextBox2 <> "" Then
     '---
     Set d = CreateObject("scripting.dictionary")
     mots = Split(Trim(Me.TextBox2), ",")
     For Each m In mots
       mots2 = Split(Trim(m), " ")
       Tbl = choix
       For i = LBound(mots2) To UBound(mots2)
         Tbl = Filter(Tbl, mots2(i), True, vbTextCompare)
       Next i
       For i = LBound(Tbl) To UBound(Tbl): d(Tbl(i)) = "": Next i
     Next m
     Tbl = d.keys
     '----
     n = UBound(Tbl) + 1
     If n > 0 Then
       ReDim Tbl2(LBound(Tbl) To n + 1, 1 To NbCol)
       For j = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(j), "|")
         For k = 0 To NbCol - 1: Tbl2(j, k + 1) = a(k): Next k
       Next j
       Me.ListBox1.List = Tbl2
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If
End Sub

Voilà, bonne fin de soirée

Filtrer une listbox sur base de mots saisis dans un textbox [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager