recherche dans listbox

**borain91** · 19/04/2020, 12h21

Bonjour,
j'aimerai faire des recherches dans ma listbox
donc j'ai une listbox avec 5 colonnes
outil, numéro, qté, marque et emplacement
j'ai rajouté 4 texbox au dessus pour faire des recherche sur ma listbox
textbox1 qui fait la recherche sur outil
textbox2 qui fait la recherche sur le numéro de l'outil qui est alpha-numérique
textbox3 qui fait la recherche sur la marque de l'outil
texbox4 qui fait la recherche sur emplacement de l'outil

j'aimerai que à chaque fois que j'écris un outil sur la texbox 1 dans ma listbox s'affiche juste l'outil commençant par la lettre frappé
te si je fait pareil dans mon texbox2 juste les numéro commencant par le numéro frappé
ainsi de suite

svp je vous remercie pour votre aide
j'ai besoin d'un code
je suis un peu novice en vba et je pense que c'est face à chaque difficulté qu'on apprends

cordialement,

**Thautheme** · 19/04/2020, 12h52

Bonjour Borain, bonjour le forum,

Comment est alimentée la ListBox ? Pourrais-tu nous fournir le code. Si ce n'est pas trop de demander bien sûr...

**borain91** · 19/04/2020, 13h15

rowsource : feuil4!a4:e100

cordialement

je joins le fichier, allez sur stock GESMAGO-2-1.xlsm

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
Option Explicit
Option Compare Text
 
Dim Ws As Worksheet
Dim T1
Sub AlimenteListbox()
Dim j As variant, i As variant, Indice As variant, D As variant, T2()
 
  Me.ListBox1.Clear
  Indice = 1            ' Par défaut toujours 1 enregistrement
  For j = 1 To UBound(T1)
    If T1(j, 1) Like Me.textbox1 & "*" And T1(j, 2) Like Me.textbox2 & "*" And T1(j, 3) Like Me.textbox3 & "*" And T1(j, 4) Like Me.textbox4 & "*" Then
      Indice = Indice + 1
      ReDim Preserve T2(1 To 5, 1 To Indice)
      For i = 1 To UBound(T1, 2)
        T2(i, Indice) = T1(j, i)
      Next i
      For D = 1 To UBound(T1, 1)
      Next D
    End If
  Next j
  If Indice > 1 Then
    Me.ListBox1.List = Application.Transpose(T2)
    Me.ListBox1.RemoveItem 0          ' On supprime l'enregistrement par défaut
  End If
 
End Sub
private sub textbox1_Change()
  AlimenteListbox
End Sub
 
private sub textbox2_Change()
  AlimenteListbox
End Sub
private sub textbox3_Change()
  AlimenteListbox
End Sub
private sub textbox4_Change()
  AlimenteListbox
End Sub
Private Sub UserForm_Initialize()
Dim j As Long, Gauche As Double, Temp As String, i As Integer
Dim Mondico As Object
 
  Set Ws = Sheets("feuil4")
 
    T1 = Ws.Range("A2:e" & Ws.Range("A" & Rows.Count).End(xlUp).Row)
    For j = 1 To UBound(T1)
      T1(j, UBound(T1, 2)) = j + 1
 
    Next j
 
  Gauche = Me.ListBox1.Left + 5
  For i = 1 To 5
 
  Next i
 
  With Me.ListBox1
 
    .List = T1
 
end witch
end sub

**Thautheme** · 19/04/2020, 14h15

Re,

Je déteste la propriété RowSource, que je trouve peu maléable...
Voici ton code modifié (ce qui n'apparait pas c'est parce que je l'ai laissé tel que tu l'avais écrit) :

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
Private COL As Byte
Private CTRL As Control
 
Private Sub UserForm_Initialize()
Me.ListBox1.RowSource = "Feuil4!A4:E100"
End Sub
 
Private Sub RECHERCHE_Change()
COL = 1
Set CTRL = Me.Controls("RECHERCHE")
Call Ali_List
End Sub
 
Private Sub MUMERO_Change()
COL = 2
Set CTRL = Me.Controls("MUMERO")
Call Ali_List
End Sub
 
Private Sub MARQUE_Change()
COL = 4
Set CTRL = Me.Controls("MARQUE")
Call Ali_List
End Sub
 
Private Sub EMPLA_Change()
COL = 5
Set CTRL = Me.Controls("EMPLA")
Call Ali_List
End Sub
 
Sub Ali_List()
Dim O As Worksheet
Dim TV As Variant
Dim I As Integer
Dim J As Byte
 
Set O = Worksheets("Feuil4")
TV = O.Range("A3").CurrentRegion
With Me.ListBox1
    .ColumnCount = 5
    .RowSource = ""
    .Clear
    For I = 2 To UBound(TV, 1)
        If UCase(CTRL.Value) = UCase(Left(TV(I, COL), Len(CTRL.Value))) Then
            .AddItem
            For J = 1 To UBound(TV, 2)
                .Column(J - 1, .ListCount - 1) = TV(I, J)
            Next J
        End If
    Next I
End With
End Sub