Discussion :

[joponta]

Bonjour,

Le code ci-dessous importe dans un listbox les données d'une feuille avec l'entête des colonnes.
La ou cela se complique, c'est lorsque je j'essaye de mettre à jour la listbox en fonction du choix dans la ComboBox1.
Je ne parviens pas à mettre à jour ni à mettre les entêtes. Je voudrais utiliser rowsource mais je n'y parviens pas.

Merci pour votre aide.

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
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
Private Sub CommandButton1_Click()
Call effacer
End Sub
 
Private Sub Lb_Liste_Click()
    On Error GoTo ErrorHandler
 
    If Me.Lb_Liste.List(Me.Lb_Liste.ListIndex, 1) = "Code parc" Then
        Me.TextBox1.value = ""
    Else
        Me.TextBox1.value = Me.Lb_Liste.List(Me.Lb_Liste.ListIndex, 1)
    End If
 
    Exit Sub
 
ErrorHandler:
    MsgBox "Une erreur s'est produite dans la procédure Lb_Liste_Click : " & Err.Description
End Sub
 
Private Sub TextBox2_Change()
    On Error GoTo ErrorHandler
 
    Dim searchText As String
    Dim ws As Worksheet
    Dim listBoxItems As Variant
    Dim i As Integer
 
    ' Réinitialiser la ListBox
    Me.Lb_Liste.Clear
 
    ' Récupérer le texte recherché dans le TextBox
    searchText = LCase(Trim(Me.TextBox2.value))
 
    ' Vérifier si le texte n'est pas vide
    If Len(searchText) > 0 Then
        ' Boucler à travers les cellules de la colonne A de la feuille "Atal"
        Set ws = ThisWorkbook.Sheets("Atal")
        If ws Is Nothing Then
            MsgBox "Feuille 'Atal' introuvable."
            Exit Sub
        End If
 
        listBoxItems = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).value
 
        For i = LBound(listBoxItems, 1) To UBound(listBoxItems, 1)
            If InStr(1, LCase(listBoxItems(i, 1)), searchText) > 0 Then
                ' Ajouter l'élément correspondant à la ListBox
                Me.Lb_Liste.AddItem listBoxItems(i, 1)
            End If
        Next i
    Else
        ' Si le texte est vide, réinitialiser la ListBox avec toutes les données
        UserForm_Activate ' Appelez la procédure UserForm_Activate pour réinitialiser la ListBox
    End If
 
    Exit Sub
 
ErrorHandler:
    MsgBox "Une erreur s'est produite dans la procédure TextBox2_Change : " & Err.Description
End Sub
 
Private Sub UserForm_Activate()
Dim th As Worksheet
Dim n As Integer
Dim C As Integer
 
Set th = Sheets("Atal")
n = Application.WorksheetFunction.CountA(th.Range("A:A"))
C = Application.WorksheetFunction.CountA(th.Rows(1))
' Set the range for the ListBox RowSource
    Set listRange = th.Range("A1:L" & n)
 
    ' Populate the ListBox on the UserForm
    With Me.Lb_Liste ' Assuming Lb_Liste is the name of your ListBox on the UserForm
        .ColumnHeads = False
        .ColumnCount = C
        .RowSource = listRange.Address
    End With
Call AlimenteCombo
End Sub
 
Private Sub AlimenteCombo()
    Dim ws As Worksheet
    Dim cell As Range
    Dim uniqueValues() As Variant
    Dim value As Variant
    Dim i As Long, j As Long, n As Long
 
    ' Référence à la feuille "Atal"
    Set ws = ThisWorkbook.Sheets("Atal")
    If ws Is Nothing Then
        MsgBox "Feuille 'Atal' introuvable."
        Exit Sub
    End If
 
    ' Parcourir la colonne A pour récupérer les valeurs uniques
    n = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ReDim uniqueValues(1 To n)
    j = 1
 
    For Each cell In ws.Range("A1:A" & n)
        value = cell.value
        If Not IsError(value) And Not IsEmpty(value) Then
            ' Vérifier si la valeur existe déjà dans uniqueValues
            For i = 1 To j - 1
                If uniqueValues(i) = value Then Exit For
            Next i
 
            If i > j - 1 Then ' La valeur n'est pas encore dans uniqueValues
                uniqueValues(j) = value
                j = j + 1
            End If
        End If
    Next cell
 
    ' Trier les valeurs uniques
    If j > 1 Then
        Call BubbleSort(uniqueValues, j - 1) ' Utiliser la méthode Bubble Sort (à définir)
    End If
 
    ' Ajouter les valeurs triées à ComboBox1
    Me.ComboBox1.Clear
    For i = 1 To j - 1
        Me.ComboBox1.AddItem uniqueValues(i)
    Next i
End Sub
 
' Méthode Bubble Sort pour trier un tableau de valeurs
Private Sub BubbleSort(arr() As Variant, ByVal n As Long)
    Dim i As Long, j As Long
    Dim temp As Variant
 
    For i = 1 To n - 1
        For j = i + 1 To n
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub
'Me.Lb_Liste.RowSource = vbNullString
Private Sub effacer()
    ' Réinitialiser la ListBox
    With Me.Lb_Liste
        .ColumnHeads = False
        .ColumnCount = 0
        .RowSource = ""
    End With
End Sub
 
Private Sub ComboBox1_Change()
    Dim ws As Worksheet
    Dim filterValue As Variant
    Dim dataRange As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim rowIndex As Long
 
    On Error GoTo ErrorHandler
 
    ' Récupérer la valeur sélectionnée dans la ComboBox
    filterValue = Me.ComboBox1.value
 
    ' Référence à la feuille "Atal"
    Set ws = ThisWorkbook.Sheets("Atal")
    If ws Is Nothing Then
        MsgBox "Feuille 'Atal' introuvable."
        Exit Sub
    End If
 
    ' Réinitialiser la ListBox
    Call effacer
 
    ' Vérifier si une valeur est sélectionnée dans la ComboBox
    If Len(filterValue) > 0 Then
        ' Déterminer la dernière ligne de données
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
        ' Parcourir les données pour trouver les lignes correspondant au filtre
        rowIndex = 0 ' Initialiser l'index de ligne
        For Each cell In ws.Range("A2:A" & lastRow) ' Commencer à la deuxième ligne pour exclure les en-têtes
            rowIndex = rowIndex + 1
            If cell.value = filterValue Then
                ' Ajouter les valeurs de la ligne correspondante à la ListBox
                For i = 1 To 11 ' Correspond aux colonnes A à K
                    Me.Lb_Liste.AddItem ws.Cells(rowIndex, i).value
                Next i
            End If
        Next cell
    Else
        ' Si aucune valeur sélectionnée, réinitialiser la ListBox avec toutes les données
        UserForm_Activate ' Appelez la procédure UserForm_Activate pour réinitialiser la ListBox
    End If
 
    Exit Sub
 
ErrorHandler:
    MsgBox "Une erreur s'est produite : " & Err.Description
End Sub

[deedolith]

Salut,

La source de données de la listbox est basée sur une plage,
il te suffit de mettre à jour cette dernière.

[joponta]

Bonjour,
J'ai réussi avec ce code. Seulement la recherche n'est pas précise. en effet lorsque je tape BRS cela ressort les ligne avec RBRS ...
Aussi est-il possible de classer à l'initialisation de formulaire et lors d'une recherche par la colonne A , la colonne C ordre décroissant et par la colonne F ordre décroissant.

Merci pour votre aide

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
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
   Set f = Sheets("Atal")
   Set Rng = f.Range("A2:J" & f.[a65000].End(xlUp).Row)
   Ncol = Rng.Columns.Count
   '---- entêtes ListBox
   x = 15
   Y = Me.ListBox1.Top - 12
   'For i = 1 To Ncol - 1
    'Set Lab = Me.Controls.Add("Forms.Label.1")
    'Lab.Caption = f.Cells(2, i)
    'Lab.Top = Y
    'Lab.Left = x + 2
    'x = x + f.Columns(i).Width * 0.8
    'temp = temp & f.Columns(i).Width * 0.8 & ";"
  'Next
  Me.ListBox1.ColumnCount = Ncol
  '--
  TblTmp = Rng.Value
   For i = LBound(TblTmp) To UBound(TblTmp)
     ReDim Preserve choix(1 To i)
     For k = LBound(TblTmp) To UBound(TblTmp, 2)
       choix(i) = choix(i) & TblTmp(i, k) & " * "
     Next k
   Next i
   Me.ListBox1.List = Rng.Value
End Sub
 
Private Sub TextBox1_Change()
   If Me.TextBox1 <> "" Then
       mots = Split(Trim(Me.TextBox1), " ")
       Tbl = choix
       For i = LBound(mots) To UBound(mots)
          Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
       Next i
       If UBound(Tbl) > -1 Then
          Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To Ncol)
          For i = LBound(Tbl) To UBound(Tbl)
            a = Split(Tbl(i), "*")
            For k = 1 To Ncol: b(i + 1, k) = a(k - 1): Next k
          Next i
          Me.ListBox1.List = b
          Me.Label1.Caption = UBound(Tbl) + 1
        Else
          Me.ListBox1.Clear
          Me.Label1.Caption = 0
        End If
   Else
     UserForm_Initialize
  End If
End Sub