Oui je vois pour la combobox, C'est assez efficace.
Mais aprés faut que je le projette sur une listbox. Je sais pas si cela est possible faut que je teste.
Oui je vois pour la combobox, C'est assez efficace.
Mais aprés faut que je le projette sur une listbox. Je sais pas si cela est possible faut que je teste.
Le filter a ete applique, maintenant il te faut
- copier/coller les donnees dans une zone vide
- pointer sur cette zone comme source de ta listbox
Je ne vois vraiment aucun intérêt (ni aucune espèce de bénéfice) à passer sur une listbox ce que l'on a sur une combobox.Oui je vois pour la combobox, C'est assez efficace.
Mais aprés faut que je le projette sur une listbox. Je sais pas si cela est possible faut que je teste.
Tout cela est pour moi une affaire simplissime.
1) on trie une première fois (une seule) les données de la colonne A. On ne les trie à nouveau (seul cas de nécessité) que lors d'un nouvel ajout éventuel
2) on lie la combobox à la plage des données de la colonne A (les seules lignes contenant des données)
3) on utilise la propriété MatchEntry de la combo
ET C'EST TOUT !
Salut,
Merci de vos conseils,
suite à la demande de patrick toulon voici un ficher xlx en PJ avec peu de données.
recherche WORLD v2 developpez_forum.xlsx
En fait la combobox ne va pas afficher dans la listbox.
Je souhaite que la liste box affiche au fur à mesure les résultats.
Pourquoi tu ne passes pas par des formulaires ou des rubans ?
Passer par des shapes, ca me fait peur pour l'utilisateur, pas toi ?
D'autre part, le probleme que tu as en nous envoyant un fichier xlsx, c'est qu'on perd tout le code que tu as pu faire jusqu'a present.
Envoie nous a minima un fichier xls =]
Ben c'est plus simple dans un userform? Que sur une shape?
J'ai laissé mes code et fait une combobox avec la MatchEntry sur les conseils de unparia.
Juste que les résultat de la colonne A soient affichés dans la listbox, en fonction de la matchentry ça serait top.
recherche WORLD v2 dev.xlsm
Oui j'ai enlevé des données qui avaient pas de sens pour simplifier le truc.
Voila un zip.
recherche WORLD v2 dev.7z
Je récapitule pour les nouveaux.
Je souhaite en fonction des valeur d'une combob0x afficher dans une listbox les résultats.
Au fur à mesure que l'utilisateur se rapproche d'un code existant il va rester une seule résultat.
Ex: FRMRS = Port de marseille.
Bon du coup, je me suis bien avancé.
J'ai crée un userform avec une combobox qui est relié à une liste box.
J'ai mis ce code qui fonctionne assez vite en fonction du matchentry du combobox
ça fait le job après je pourrais faire mieux je pense mais vais arrêter de vous embêter. Vous m'avez déjà bien aidé.
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 Private Sub ComboBox1_Change() Dim db As Worksheet Dim wb As Workbook Dim sc As Worksheet Set wb = ActiveWorkbook Set db = Sheets("Dbase") Set sc = Sheets("Results") Application.ScreenUpdating = False If ComboBox1 <> "" Then ListBox1.clear ' For ligne = 2 To 104987 If db.Cells(ligne, 2) Like "*" & ComboBox1 & "*" Then ListBox1.AddItem db.Cells(ligne, 1) End If Next Else '"" End If End Sub
recherche WORLD - vf1 dev.7z
re
d'accord j'ai téléchargé ton fichier
alors il me viens une question puisque tu n'a pas de doublons pourquoi ne pas faire un find!!! directement pas besoins de boucler
la je comprends vraiment pas
d'autant plus que puisqu'il n y a pas de doublons a quoi te sert la listebox hein dis moi ????????? tu n'en aura toujours qu'un d'item dedans
j'en perds mon chinois moi
c'est plus un soucis de conception la !!
bref si tu sais un jour ce que tu veux vraiment nous le savoir hein!!!!
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 Private Sub ComboBox1_Change() test End Sub Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) test End Sub Sub test() With CreateObject("adodb.connection") .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1""" .Open With .Execute("Select[Code Port / /Nom Ville] from [Dbase$] where [Code Port] like '%" & ComboBox1 & "%'") Me.ListBox1.Clear If .EOF = False Then Me.ListBox1.List = WorksheetFunction.Transpose(.getrows) .Close End With .Close End With End Sub
Dernière modification par Invité ; 22/09/2016 à 23h27.
Hello,
Merci pour vôtre aide,
Ben j'aimerais bien faire find mais je suis pas arrivé l'adapter à mon code. Je boucle parce-que, c'est le meilleur moyen d'afficher, lorsque l'utilisateur ne connait que les 2 première lettre du pays. Par exemple FR pour la France, ça va boucler et afficher l'ensemble des codes ports qui commence par FR.
Avec find ça donne le même résultat?
Merci rdurupt, mais ça fonctionne pas de manière optimale, ça lag plus qu'avec ma boucle. Comprend pas vu que ton code est bien plus pêchu.
Last update de mon code.
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 Private Sub ComboBox1_Change() Dim db As Worksheet Dim wb As Workbook Dim sc As Worksheet Set wb = ActiveWorkbook Set db = Sheets("Dbase") Set sc = Sheets("Results") Application.ScreenUpdating = False If ComboBox1 = "" Then ListBox1.clear Call UserForm_Initialize ElseIf ComboBox1 <> "" Then ListBox1.clear '"************************************************************* For ligne = 2 To 104987 If db.Cells(ligne, 2) Like ComboBox1 & "*" Then ListBox1.AddItem db.Cells(ligne, 1) End If Next End If End Sub
Bonjour,
j'ai pris en cour de route et j'ai pas tout lue et ça je ne comprend pas ce que ça veux dire!mais ça fonctionne pas de manière optimale, ça lag plus qu'avec ma boucle
de sur-crois, pour ton fichier fais dans l'explorateur Windows fais un click droit dessus et dans la liste chois dossier compressé ca je ne peux pas l'ouvrir!
Bonjour à tous,
Voici ma proposition.
Je suis revenu à la demande initiale, en conservant le textbox et la listbox sur la feuille, mais cela fonctionne également avec une Combobox (attention au choix de l'événement déclencheur) et une ListBox posées sur un userForm...
Cela présuppose également que les données sont dans la feuille "Feuil2", dans les colonnes A à C, sinon modifiez les constantes...
J'ai fait s'afficher les trois colonnes dans la ListBox, donc veillez à ce qu'elle soit bien Multi-Colonnes (ListBox1.ColumnCount = 3)
Attention, j'ai bien précisé qu'il s'agit d'une usine à gaz...
Cependant, le résultat, testé sur 50000 lignes s'affiche immédiatement, prévoir un petit délai pour 204281.
Dans le module de la feuille (ou de l'UserForm le cas échéant) :
Dans un module :
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 Option Explicit Const maPlage As String = "A2:C104987" Const maColonne As Byte = 2 Const maFeuil As String = "Feuil2" Private Sub TextBox1_Change() Dim lngTest As Long, varTableau As Variant On Error Resume Next lngTest = UBound(Tb) If Err <> 0 Then Tb = Range_To_Tb(Sheets(maFeuil).Range(maPlage)) On Error GoTo 0 If TextBox1 <> "" Then varTableau = Filtre_Tableau(Tb, maColonne, TextBox1 & "*", "Like") On Error Resume Next lngTest = UBound(varTableau) If Err <> 0 Then ListBox1.Clear: Exit Sub On Error GoTo 0 ListBox1.List = varTableau Else ListBox1.Clear End If End Sub
EDIT : J'ai ajouté une constante Colonne. Dans mon exemple, je recherche dans la colonne 2 (B) du tableau de données.
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186 Option Explicit Public Tb As Variant Public Function Range_To_Tb(Plage As Range) As Variant() If Plage.Cells.Count < 2 Then Dim tablo(1 To 1, 1 To 1) tablo(1, 1) = Plage.Value Range_To_Tb = tablo Erase tablo Else Range_To_Tb = Plage.Value End If End Function Public Function Filtre_Tableau(ByVal Tableau As Variant, _ Item As Variant, _ Key1 As Variant, _ Optional test As String = "=") As Variant Dim Tbl() As Variant, i As Long, j As Long, Cpt As Long, Colonne As Long, TestColonne As Variant Select Case VarType(Item) Case 8: Colonne = Retourne_Colonne(Tableau, Item) Case 2, 3, 17: Colonne = CLng(Item) Case Else: GoTo Erreur_Colonne End Select On Error GoTo Erreur_Colonne TestColonne = Tableau(LBound(Tableau, 1), Colonne) On Error GoTo 0 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide.": Exit Function Case 1 MsgBox "Le tableau passé en paramètre ne comporte qu'une colonne." Exit Function Case 2 If IsDate(Key1) Then Key1 = CDate(Key1) If IsNumeric(Key1) Then Key1 = CLng(Key1) Select Case test Case "=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) = Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) < Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case ">" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) > Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) <= Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case ">=" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) >= Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "<>" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, Colonne) <> Key1 Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case "Like" For i = LBound(Tableau, 1) To UBound(Tableau, 1) If UCase(Tableau(i, Colonne)) Like UCase(Key1) Then Cpt = Cpt + 1 ReDim Preserve Tbl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To Cpt) For j = LBound(Tableau, 2) To UBound(Tableau, 2) Tbl(j, Cpt) = Tableau(i, j) Next j End If Next i Case Else MsgBox "Le paramètre facultatif Test est erroné." Exit Function End Select On Error GoTo resultat_Vide TestColonne = Tbl(UBound(Tbl, 1), UBound(Tbl, 2)) On Error GoTo 0 Filtre_Tableau = Transposition(Tbl) Erase Tbl Case Else MsgBox "Le tableau comporte plus de deux dimensions. La fonction n'est pas adaptée à ce cas." End Select Exit Function Erreur_Colonne: MsgBox "Le paramètre Item est erroné." Exit Function resultat_Vide: MsgBox "Le filtre renvoie un tableau vide de données." End Function Public Function Nb_Dimensions(Tableau As Variant) As Integer Dim D As Integer, t As Long On Error GoTo fin Do: D = D + 1: t = UBound(Tableau, D): Loop fin: Nb_Dimensions = D - 1 End Function Public Function Transposition(ByRef Tableau As Variant) As Variant Dim tabl, i As Long, j As Long Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 ReDim tabl(LBound(Tableau) To UBound(Tableau), LBound(Tableau) To 1) For i = LBound(Tableau) To UBound(Tableau) tabl(i, LBound(Tableau)) = Tableau(i) Next Transposition = tabl Erase tabl Case 2 ReDim tabl(LBound(Tableau, 2) To UBound(Tableau, 2), LBound(Tableau, 1) To UBound(Tableau, 1)) For i = LBound(Tableau, 1) To UBound(Tableau, 1) For j = LBound(Tableau, 2) To UBound(Tableau, 2) tabl(j, i) = Tableau(i, j) Next j Next i Transposition = tabl Erase tabl Case Else MsgBox "Le tableau comporte plus de deux dimensions" End Select End Function Public Function Retourne_Colonne(ByRef Tableau As Variant, _ Texto As Variant) As Long Dim i As Long, j As Integer Retourne_Colonne = -1 Select Case Nb_Dimensions(Tableau) Case 0 MsgBox "Le tableau passé en paramètre est vide." Case 1 MsgBox "Le tableau passé en paramètre n'a qu'une dimension" Case 2 For i = LBound(Tableau, 1) To UBound(Tableau, 1) For j = LBound(Tableau, 1) To UBound(Tableau, 1) If Tableau(i, j) = Texto Then Retourne_Colonne = j: Exit Function Next j Next i Case Else MsgBox "Le tableau comporte plus de deux dimensions." End Select End Function
moi avec ta version j'ai le sablier! la mienne c'est instantané????!mais ça fonctionne pas de manière optimale, ça lag plus qu'avec ma boucle. Comprend pas vu que ton code est bien plus pêchu.
Moi
Toi
Dernière modification par AlainTech ; 25/09/2016 à 15h03. Motif: Correction balises
Hello,
Oue j'ai testé ton code de nouveau ça semble bien fonctionné merci.
En fait c'est surtout que j'ai moins le sablier en effet.
Petite question, si je veux que le résultat affiché soit en fonction des deux premières lettre. Je dois décaler le like "%" ou?
Ex : IT liste tous les codes qui commencent par IT. En fait ça permet par exemple d'obtenir tous les codes italien.
Encore merci rudupt
Code : Sélectionner tout - Visualiser dans une fenêtre à part Execute("Select[Code Port / /Nom Ville] from [Dbase$] where [Code Port] like '%" & Replace(ComboBox1, "*", "%") & "%'")
tu tape le 2 première lettre et tu supprime ce qui est grisés dans sélection automatique! la notion like '%" & Replace(ComboBox1, "*", "%" est prise en compte dans la requête * c'est juste pour filtre sur plusieurs fragment de phrase! (F*V*8) = (FRVG8) entre autre possibilités!
Sur un requête Sql like c'est pas[*] mais [%]
mais l’exemple de l'image de mon poste précédant fonctionne!
Dernière modification par Invité ; 26/09/2016 à 14h36.
bon soyons sérieux ou pas c'est juste une question d'interprétation
robert ravi de te voir parmi nous
bon moi j'ai une autre solution si vous voulez bien la regarder de plus prêt
j'ai pris une salle mani de transformer une variable tableaux en string et vice et versa déjà la ca devrait vous titiller a l'oreille
alors
a l'activate de ton userform tu va essayer ceci:
comme tu peux le voir c'est assez simple on créé un tableau (variable tableau)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Private Sub UserForm_Activate() With Sheets("Dbase"): tableau = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value: End With tabstring = Join(Application.Transpose(Application.Index(tableau, , 1)), ";") Debug.Print tabstring End Sub
on en recupere la colonne 1 (en plus y en a qu'une c'est facile)dans un array a 1 dimension et horizontale
ensuite on join les items avec comme séparateur (jai choisi le ";")
on obtiens donc a partir de ceci:
1 2 3 4 etc.....
5et.....
on obtien ceci:
1 2 3 4 et.....
tu vois c'est pas compliqué
maintenant dans le change de ta combobox1 tu split le te texte obtenue par la valeur de celle ci et tu gardera la partie 2 (1 en terme d'item)
maintenant que tu a ta liste en string a partir de l'indice de la combo tu la re split par les ";" et tu fout le split dans la listebox1
point barre !!!!
c'est instantané!!!!! avec les outils les plus basiques de VBA
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 Dim tabstring Private Type Position Left As Single Top As Single End Type dim tabstring as string Private Sub UserForm_Activate() With Sheets("Dbase"): tableau = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value: End With tabstring = Join(Application.Transpose(Application.Index(tableau, , 1)), ";") Debug.Print tabstring' juste pour regarder le résultat dans le debug End Sub Private Sub ComboBox1_Change() ListBox1.Clear If UBound(Split(tabstring, "Code Port : " & ComboBox1)) > 0 And ComboBox1.Value <> "" Then code = "Code Port : " & ComboBox1 & Split(tabstring, ComboBox1)(1) ListBox1.List = Split(code, ";") End If End Sub Private Sub UserForm_Layout() Static Pos As Position Dim Mvd As Boolean 'If the form is just being initialized, store the position If Pos.Left = 0 Or Pos.Top = 0 Then Pos.Left = Me.Left Pos.Top = Me.Top Exit Sub End If 'Check to see if the form has been moved Mvd = False If Me.Left <> Pos.Left Then Me.Left = Pos.Left Mvd = True End If If Me.Top <> Pos.Top Then Me.Top = Pos.Top Mvd = True End If If Mvd Then MsgBox "Please don't move me !", vbCritical End If End Sub
Hello Patrick Toulon,
Merci à toi
Oui je pense qu'il y à une coquille ou je sais pas mais j'ai une erreur.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 Dim tabstring Private Type Position Left As Single Top As Single End Type dim tabstring as string 'nom ambigue
oui !! enlève celui d'en haut
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager