Discussion :

[nananinanana]

Bonjour à tous,

Je souhaiterai pourvoir effectuer des filtres horizontaux, multicritères à l'aide d'un userform et d'un champ recherche

La première partie de code permet de rechercher un fichier, je souhaite pouvoir sélectionner plusieurs item et que lorsque je recherche un item je puisse avoir le choix (ajouter à la selection ou filtrer avec, un peu comme le filtre vertical déjà par défaut)

Or cette première partie de code ne permet pas d'ajouter à la une selection une fois que j'efface le textbox la listbox se réinitialise,

aussi pour masquer les colonnes mon essai était beaucoup trop long et faisait planter l'application, Y a-t-il une solution autre que de passer par for i = .. to ... if tab<>listbox then cellshiddencolumn=true (en gros)

Merci d'avance

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
Option Compare Text
 
Private Sub TextBox2_Change()
Dim derl%
derl = Worksheets("GMD").Cells(Rows.Count, 2).End(xlUp).Row
 
Application.ScreenUpdating = False
If TextBox2 <> "" Then
ListBox2.Clear
        For Ligne = 7 To derl
            If Cells(Ligne, 2) Like "*" & TextBox2 & "*" Then
                ListBox2.AddItem Cells(Ligne, 2) 'Exemple 2 (ListBox)
            End If
        Next
    End If
End Sub
 
Private Sub CommandButton2_Click()
Unload Me
End Sub
 
Private Sub ListBox2_Click()
 
End Sub

J'ai initialisé mon userforme avec des données de mon fichier

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
 
Private Sub UserForm_Initialize()
    Dim cell1 As Range
    Dim Unique1 As New Collection
    Dim Valeur1
    Dim i As Integer
    Dim derl%
 
i = Worksheets("GMD").Cells(Rows.Count, 2).End(xlUp).Row
    On Error Resume Next
    'boucle sur les Cell1ules de la colonne A
    For Each cell1 In Worksheets("gmd").Range("B7:B" & i)
        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        If cell1 <> "" Then
        Unique1.Add cell1, CStr(cell1)
        End If
    Next cell1
    On Error GoTo 0
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur1 In Unique1
        Me.ListBox2.AddItem Valeur1
        Me.ListBox2.MultiSelect = fmMultiSelectMulti
        Me.ListBox2.ListStyle = fmListStyleOption
    Next Valeur1
 
Set Unique1 = Nothing
End Sub