Formulaire VBA Excel - recherche sur plusieurs critères et affichage des résultats

**kl1ft** · 04/08/2011, 11h42

Bonjour à toutes et tous,

j'ai besoin d'aide pour mettre au point un formulaire de recherche sur plusieurs critères...

Je ne sais pas comment m'y prendre... il y a des codes déjà existant mais je ne les comprends pas... où ils ne font pas ce que je voudrais bien qu'ils fassent.

J'ai mis en PJ mon fichier, j'aimerais dans la mesure du possible avoir un formulaire (cf. ébauche de mon formulaire Alt+F11 ==> useform1) permettant à l'utilisateur de faire une recherche sur un ou plusieurs critères et d'afficher les résultats dans une box.

Merci par avance,

Je continue à cherche de mon côté mais je coince...

kl1ft

Invité · 04/08/2011, 19h35

Salut Kl1ft

Tu peux essayer ce code
Bouton Clear

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Clear_Click()
' Clear the form
  For Each ctl In Me.Controls
    If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
      ctl.Value = ""
    ElseIf TypeName(ctl) = "CheckBox" Then
      ctl.Value = False
    End If
  Next ctl
  Me.ListBox1.Clear
End Sub

Bouton Search

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
Private Sub Search_Click()
  Dim Ind As Integer, DLig As Long, Lig As Long
  Dim TabCrit() As String, FlgFind As Boolean
  ' Tableau des champs pas rapport au sens des colonnes
  TabCrit = Split("Title,Type_Document,Date_publication,Author,Subject,Keywords", ",")
  ' Mettre le flag de valeur trouvée à FAUX
  FlgFind = False
  ' Effacer la ListBox avant
  Me.ListBox1.Clear
  ' Avec la feuille
  With Sheets("Gestion des documents")
    ' Mémoriser la dernière ligne remplie du tableau
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 2 To DLig
      ' Pour chaque critère
      For Ind = 0 To 5
        ' Si le critère de recherche a été renseigné
        If Me.Controls(TabCrit(Ind)) <> "" Then
          ' Si le critère ressemble au contenu de la cellule
          If UCase(.Cells(Lig, 2 + Ind)) Like UCase("*" & Me.Controls(TabCrit(Ind)) & "*") Then
            ' Mettre le Flag trouvé à VRAI
            FlgFind = True
          Else
            ' Sinon mettre le Flag trouvé à FAUX
            FlgFind = False
          End If
        End If
      Next Ind
      ' Si le flag valeurs trouvées est toujours à vrai, on a trouvé une correspondance
      If FlgFind = True Then
        ' Ajouter l'item
        Me.ListBox1.AddItem .Cells(Lig, 2)
        ' Pour chaque colonne
        For Ind = 1 To 5
          ' Ajouter les valeurs correspondantes
          Me.ListBox1.List(Me.ListBox1.ListCount - 1, Ind) = .Cells(Lig, 2 + Ind)
        Next Ind
      End If
    Next Lig
  End With
End Sub

Qui selon le nombre de critères renseignés, inscrit les valeurs des lignes correspondantes

Attention ta combobox doit avoir la propriété : ColumnCount = 8

A+

**kl1ft** · 04/08/2011, 21h46

J'ai testé le code dans mon ébauche de useform que j'ai joint à la première discussion.

Ca fonctionne, mais (il y a un toujours un mais...)

Lorsque je sélectionne un ou 2 critères seulement, cela me renvoie pas les données comme il faut. J'ai lu ton code, je débute avec les macros de recherche;

J'ai vu des macro utilisant les "flag", ça à l'air incontournable pour ce genre de code.

Dans l'absolue, j'aimerai pouvoir faire une recherche sur 1, 2, 3 ... ou encore sir tous les critères peu importe ceux que j'aurais choisi et que cela me renvoie dans la fenêtre le Title et le lien (si possible actif pour cliquer dessus)...

Et pouvoir faire plusieurs recherches à la suite les unes des autres. La listbox ne se rafraichit plus après la première recherche.

J'aimerais pouvoir t'aider plus sur le développement de la chose mais je suis actuellement en "mode" apprentissage !

J'essaye de comprendre le fonctionnement des codes des moteurs de recherche VBA.

A mon avis on tient le bon bout, manque plus qu'à peaufiner.

Merci encore pour ton aide si précieuse !!

Invité · 04/08/2011, 23h01

Re,

Après plusieurs test il s'avère effectivement que j'ai un problème dans mon code, j'ai donc fait totalement autrement

Je comptabilise le nombre de critères remplis et le nombre de valeurs qui correspondent, si les 2 chiffres sont équivalent, on ajoute à la liste

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
Private Sub Search_Click()
  Dim Ind As Integer, DLig As Long, Lig As Long
  Dim TabCrit() As String, NbCrit As Integer, NbFind As Integer
  ' Tableau des champs pas rapport au sens des colonnes
  TabCrit = Split("Title,Type_Document,Date_publication,Author,Subject,Keywords", ",")
  ' Effacer la ListBox avant
  Me.ListBox1.Clear
  ' Avec la feuille
  With Sheets("Gestion des documents")
    ' Mémoriser la dernière ligne remplie du tableau
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 2 To DLig
      ' Mettre le nombre de critères et le nombre de valeurs trouvées à ZERO
      NbCrit = 0: NbFind = 0
      ' Pour chaque critère
      For Ind = 0 To 5
        ' Si le critère de recherche a été renseigné
        If Me.Controls(TabCrit(Ind)) <> "" Then
          NbCrit = NbCrit + 1
          ' Si le critère ressemble au contenu de la cellule
          If UCase(.Cells(Lig, 2 + Ind)) Like UCase("*" & Me.Controls(TabCrit(Ind)) & "*") Then
            ' Comptabiliser le nombre de valeurs correspondantes
            NbFind = NbFind + 1
          End If
        End If
      Next Ind
      ' Si le nombre de critères rempli = le nombre de valeurs trouvées
      If NbCrit = NbFind Then
        ' Ajouter l'item
        Me.ListBox1.AddItem .Cells(Lig, 2)
        ' Pour chaque colonne
        For Ind = 1 To 5
          ' Ajouter les valeurs correspondantes
          Me.ListBox1.List(Me.ListBox1.ListCount - 1, Ind) = .Cells(Lig, 2 + Ind)
        Next Ind
      End If
    Next Lig
  End With
End Sub

En revanche pour le rafraichissement, il suffit d'effacer la Listbox avant

Ci-joint ton fichier avec le code modifié également pour le double clique dans la listbox qui ouvre le lien de la colonne I si celui-ci existe

A+

**mercatog** · 05/08/2011, 00h41

Bonsoir
Une proposition en utilisant un filtre automatique

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
Private Sub Search_Click()
Dim Plage As Range, c As Range
Dim LastLig As Integer
Dim TbCrit, TbCol
Dim i As Byte
 
Application.ScreenUpdating = False
TbCrit = Array(Me.Title, Me.Date_publication, Me.Type_Document, Me.Author, Me.Subject, Me.Keywords)
TbCol = Array(1, 3, 2, 4, 5, 6)
With Sheets("Gestion des documents")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Plage = .Range("B1:G" & LastLig)
    For i = 0 To 5
        If TbCrit(i) <> "" Then
            If i = 1 Then
                If TbCrit(1) <> "N/A" Then Plage.AutoFilter field:=3, Criteria1:=">=" & CLng(DateValue("1/1/" & TbCrit(1))), Criteria2:="<=" & CLng(DateValue("31/12/" & TbCrit(1)))
            Else
                Plage.AutoFilter field:=TbCol(i), Criteria1:=IIf(i = 5, "*" & TbCrit(i) & "*", TbCrit(i))
            End If
        End If
    Next i
    With Me.ListBox1
        .ColumnCount = 6
        .Clear
    End With
    If .Range("B1:B" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Set Plage = .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible)
        For Each c In Plage
            Me.ListBox1.AddItem c
            For i = 1 To 5
                Me.ListBox1.List(Me.ListBox1.ListCount - 1, i) = c.Offset(0, i)
            Next i
        Next c
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub

**kl1ft** · 05/08/2011, 09h23

Bonjour à vous deux

Merci pour vos contributions !!

Bruno ça fontionne du tonnerre pour l'instant

J'ai testé ton code, il fait ce que je voulais !

Mercatog, je n'ai pas encore eu l'occasion de tester le tien mais je vais m'y coller.

Merci à vous deux encore une fois !

**kl1ft** · 05/08/2011, 11h34

Mercatog,

J'ai testé ton code, mais il ne fonctionne qu'en partie... les recherches auteur et titre ne donnent rien.

Merci,

Kl1ft

Envoyé par mercatog

Bonsoir
Une proposition en utilisant un filtre automatique

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
Private Sub Search_Click()
Dim Plage As Range, c As Range
Dim LastLig As Integer
Dim TbCrit, TbCol
Dim i As Byte
 
Application.ScreenUpdating = False
TbCrit = Array(Me.Title, Me.Date_publication, Me.Type_Document, Me.Author, Me.Subject, Me.Keywords)
TbCol = Array(1, 3, 2, 4, 5, 6)
With Sheets("Gestion des documents")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Plage = .Range("B1:G" & LastLig)
    For i = 0 To 5
        If TbCrit(i) <> "" Then
            If i = 1 Then
                If TbCrit(1) <> "N/A" Then Plage.AutoFilter field:=3, Criteria1:=">=" & CLng(DateValue("1/1/" & TbCrit(1))), Criteria2:="<=" & CLng(DateValue("31/12/" & TbCrit(1)))
            Else
                Plage.AutoFilter field:=TbCol(i), Criteria1:=IIf(i = 5, "*" & TbCrit(i) & "*", TbCrit(i))
            End If
        End If
    Next i
    With Me.ListBox1
        .ColumnCount = 6
        .Clear
    End With
    If .Range("B1:B" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
        Set Plage = .Range("B2:B" & LastLig).SpecialCells(xlCellTypeVisible)
        For Each c In Plage
            Me.ListBox1.AddItem c
            For i = 1 To 5
                Me.ListBox1.List(Me.ListBox1.ListCount - 1, i) = c.Offset(0, i)
            Next i
        Next c
        Set Plage = Nothing
    End If
    .AutoFilterMode = False
End With
End Sub

**kl1ft** · 05/08/2011, 13h36

J'ai mis en pj le fichier sur lequel je travaille actuellement.

J'ai modifié le formulaire, il y a 4 onglets pour 4 actions (Ajouter / Modifier / Supprimer / Rechercher)

J'ai tout copier-coller à la lettre, essayé de comprendre la macro mais je n'arrive pas à comprendre ce qui fait que cela ne fonctionne plus... j'ai pourtant rien changé.

Une petite explication serait la bienvenue que je comprennes mon oublie

Merci à vous

**mercatog** · 05/08/2011, 13h42

Remplace la ligne 19 par celle ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Plage.AutoFilter field:=TbCol(i), Criteria1:="*" & TbCrit(i) & "*"

En fait, le code précédent recherchait les expressions exactes (sauf pour le champs Keywords)
Avec cette modification, tu auras les lignes contenant l'expression de recherche.

**kl1ft** · 05/08/2011, 14h38

Merci mercatog !!

Ca fonctionne

Encore une petite chose, comment faire pour que lorsque l'on clique sur le résultat on accéde au document voulu via le lien ?

Merci,

Tout est impec sinon !!

**tocnic** · 28/08/2016, 11h58

Hello kl1ft !

Une petite question qui peut paraître idiote mais comment as-tu rempli tes combobox date de publication et type de document ?

Merci d'avance pour ta réponse !