UserForm Recherche multicritères
Bonjour,
Voilà, j'aimerai créer un UserForm (page d'accueil bouton Rechercher) dans mon fichier qui fonctionnerai comme des filtres (mais pour des raisons pratiques je préfère créer un module de recherche).
J'ai trouvé quelques réponses dans quelques sujets mais il me manque quelques infos.
Notamment, comment filtrer mes entreprises par secteurs activités (liste prédéfinie) et par sous-catégories (une entreprise peut avoir une ou plusieurs sous-catégorie) cela reviendrai à un filtre de type "contient..." et on en choisi plusieurs.
et j'aimerai pouvoir sélectionner les résultats qui apparaissent dans la liste box, et que quand je clique sur OK, toute la ligne qui correspond à l'entreprise dans la feuille "bd" soient renvoyés dans la feuille "résultat"
Pour plus de compréhension je joins mon fichier. (je suis débutante en VBA du coup je ne sais pas si ce que je demande est possible, facile ou difficile à mettre en place)
Merci à tous
Finalement j'ai réussi à trouver la solution à mon problème
Private Sub UserForm_Initialize()
recherche_secteur.RowSource = ("code!secteur") ' remplir la liste des secteurs d'activités
recherche_secteur.ListIndex = -1
'Format de la zone d'affichage des résultats
resultats.ColumnCount = 5
resultats.ColumnWidths = "110;90;70;150;120"
End Sub
Private Sub recherche_categorie_Change()
Dim sep, i
If recherche_categorie.ListIndex <> -1 Then
recherche_mot_categorie = ""
sep = ""
For i = 0 To recherche_categorie.ListCount - 1
If recherche_categorie.Selected(i) = True Then
recherche_mot_categorie = recherche_mot_categorie & sep & recherche_categorie.List(i)
If sep = "" Then sep = ", "
End If
Next i
End If
End Sub
Private Sub recherche_mot_categorie_Change()
Dim Plage As Range, cell As Range
Dim recherche As String, adresse As String
Dim Ligne As Integer, n As Integer
Dim c As Range
resultats.Clear
n = 0
recherche = recherche_mot_categorie.Value
Range("Q1").Select
Ligne = Sheets("bd").Range("q" & "65536").End(xlUp).Row
Set Plage = Sheets("bd").Range("q" & "1:" & "q" & Ligne)
With Plage
Set c = .Find(recherche, , xlValues, xlPart)
If Not c Is Nothing Then
adresse = c.Address
Do
Me.resultats.AddItem c.Offset(0, 0), n
Me.resultats.List(n, 0) = c.Offset(0, -16)
Me.resultats.List(n, 1) = c.Offset(0, -13)
Me.resultats.List(n, 2) = c.Offset(0, -11) '
Me.resultats.List(n, 3) = c.Offset(0, -2)
Me.resultats.List(n, 4) = c
n = n + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adresse
End If
End With
End Sub