Moteur de recherche via VBA
Bonjour,
J'ai un gros problème sa fais plusieurs mois que je travaille sur excel et j'essaye de créer un moteur de recherche qui rechercherai des films mais je ne sais pas par ou commencer le codage et surtout je ne comprend pas comment faire pour relier la base de donnée a VBA
J'aimerai pouvoir joindre mon travail mais je ne sais pas faire je suis nouveau sur le forum
Bonjour,
Tu peux utiliser un formulaire sur lequel tu poses un TextBox et une ListBox. Au fur et à mesure que tu saisis des lettres, les films correspondants sont inscrit dans la ListBox. Cette dernière doit avoir deux colonnes, une pour les titres de films et l'autre cachée pour recevoir le numéro de la ligne correspondante. Voilà un début de code pour tester. Les films sont en colonne A :
Option Compare Text 'afin de ne pas tenir compte de la casse (majuscule, minuscule)
Dim Plage As Range
Private Sub UserForm_Initialize()
'défini la plage sur la colonne A de la feuille active à partir de A2
With ActiveSheet: Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
'modifi certains propriétés de la ListaBox
With ListBox1
.Width = 250
.ColumnCount = 2
.ColumnWidths = "250;0"
End With
End Sub
Private Sub TextBox1_Change()
Dim Cel As Range
'vide au préalable...
ListBox1.Clear
'effectue la recherche et inscrit les résultats dans la ListBox
For Each Cel In Plage
If Cel.Value Like TextBox1.Text & "*" Then
ListBox1.AddItem Cel.Value
ListBox1.Column(1, ListBox1.ListCount - 1) = Cel.Row
End If
Next Cel
End Sub
Private Sub ListBox1_Click()
'pour le test !
With ListBox1
MsgBox "Le film est " & .Column(0, .ListIndex) & " situé à la ligne " & .Column(1, .ListIndex)
End With
End SubWaouh merci beaucoup je vais enfin pouvoir avancer un peu
J'ai juste une dernière question
Est ce possible que lorsqu'on que on effectue la recherche et que on appui sur le film trouvé sa nous redirige sur un autre UserForm sur lequel j'inscrirai toute les information dont j'ai besoin sur le film ?
Voilà ! Ici, le test est sur 3 TextBox et c'est sur la feuille active que sont récupérées les valeurs :
Private Sub ListBox1_Click()
Dim Fe As Worksheet
Set Fe = ActiveSheet
'Set Fe = Worksheets("Feuil1") '<-- adapter le nom de la feuille et supprimer la ligne précédente
'charge le second UserForm en mémoire sans l'afficher
Load UserForm2
'rempli ses contrôles avec les valeurs par rapport au numéro de ligne
With ListBox1
UserForm2.TextBox1.Text = Fe.Cells(.Column(1, .ListIndex), 1).Value 'colonne A
UserForm2.TextBox2.Text = Fe.Cells(.Column(1, .ListIndex), 2).Value 'colonne B
UserForm2.TextBox3.Text = Fe.Cells(.Column(1, .ListIndex), 3).Value 'colonne C
'etc...
End With
UserForm2.Show
End SubMerci beaucoup de votre aide vous nous avez fais avancer énormément mais malgré plusieurs tentative je ne comprend pas comment faire pour rechercher sur toutes les colonnes il suffirait juste modifier une ligne mais je ne trouve pas laquelle.. Merci encore une fois de votre aide
Bonjour,
Dans ce cas, je te re-poste le code complet avec une fonction (DefPlage) pour récupérer toute la zone utilisée sur la feuille. Attention, la recherche sera plus longue. Si ta plage est relativement grande, il serai judicieux de passer par un tableau mais teste déjà ceci :
Option Compare Text 'afin de ne pas tenir compte de la casse (majuscule, minuscule)
Dim Plage As Range
Private Sub UserForm_Initialize()
'défini la plage sur toute la feuille active (appel de la fonction DefPlage)
Set Plage = DefPlage(ActiveSheet)
'modifi certains propriétés de la ListaBox
With ListBox1
.Width = 250
.ColumnCount = 2
.ColumnWidths = "250;0"
End With
End Sub
Private Sub TextBox1_Change()
Dim Cel As Range
'vide au préalable...
ListBox1.Clear
'effectue la recherche et inscrit les résultats dans la ListBox
For Each Cel In Plage
If Cel.Value Like TextBox1.Text & "*" Then
ListBox1.AddItem Cel.Value
ListBox1.Column(1, ListBox1.ListCount - 1) = Cel.Row
End If
Next Cel
End Sub
Private Sub ListBox1_Click()
Dim Fe As Worksheet
Set Fe = ActiveSheet
'Set Fe = Worksheets("Feuil1") '<-- adapter le nom de la feuille et supprimer la ligne précédente
'charge le second UserForm en mémoire sans l'afficher
Load UserForm2
'rempli ses contrôles avec les valeurs par rapport au numéro de ligne
With ListBox1
UserForm2.TextBox1.Text = Fe.Cells(.Column(1, .ListIndex), 1).Value 'colonne A
UserForm2.TextBox2.Text = Fe.Cells(.Column(1, .ListIndex), 2).Value 'colonne B
UserForm2.TextBox3.Text = Fe.Cells(.Column(1, .ListIndex), 3).Value 'colonne C
'etc...
End With
UserForm2.Show
End Sub
Function DefPlage(Fe As Worksheet) As Range
With Fe
Set DefPlage = .Range(.Cells(1, 1), _
.Cells(.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
End FunctionBonjour, je travaille avec Clément sur ce projet. Notre but est donc de créer un moteur de recherche à partir d'une base de donée excel sur des films. L'un des points qui fait qu'un moteur de recherche est plus utilisé qu'un autre est la pertinence. Je sais que je m'avance un peu, mais je voudrais savoir si il serait possible de donner un "score" aux différents films : par exemple, si on retrouve un mot de la recherche dans le titre du film, on donne 3 ou 4 points, puis 1 point si on trouve un mot en commun dans une autre colonne, comme le résumé ...
Un autre point qu'on voudrait intégrer au moteur de recherche est la suppression des "stop-words" avant la recherche, mais je ne sais pas si c'est réalisable sur VBA.
Merci encore pour vos réponses qui nous aident beaucoup.
Bonjour,
Voici un code retravaillé mais qui va sûrement demander une optimisation. Afin de donner une note selon où est trouvé le mot, j'ai ajouté une colonne à la ListBox afin d'inscrire un 4 si le mot est trouvé dans le nom du film (situé en colonne A sinon, adapter) et 1 si ailleurs. Si trouvé à plusieurs endroits sur la même ligne, les chiffres seront séparés par une virgule, à vous d'adapter selon vos besoins.
Concernant les noms vides, j'ai créé un tableau contenant une petite partie de ces noms et si un de ces dernier est entré dans le TextBox, fin de procédure mais seulement si ils sont positionnés en premier. Si il doivent être évités en étant à l'intérieur des phrases c'est possible mais ça va être plus complexe.
J'ai entre autre rajouté une condition (If Len(TextBox1.Text) < 2 Then) qui fait que si seulement 2 lettres sont entrées dans le TextBox, la recherche sera faite sur le début du texte dans la cellule en cours et sinon, la recherche sera faite dans tout le texte de la cellule en cours.
Les commentaires sont dans le code pour plus de compréhension :
Private Sub UserForm_Initialize()
'défini la plage sur toute la feuille active (appel de la fonction DefPlage)
Set Plage = DefPlage(ActiveSheet)
'modifi certains propriétés de la ListaBox
With ListBox1
.Width = 350
.ColumnCount = 3
.ColumnWidths = "250;50;50"
End With
End Sub
Private Sub TextBox1_Change()
Dim Cel As Range
Dim I As Long
Dim TblNomsVides
Dim Chaine As String
TblNomsVides = Array("et", "ou", "la", "le", "les", "car") 'etc...
'vide au préalable...
ListBox1.Clear
'evite de récupérer tous les films si le TextBox est vide
If TextBox1.Text = "" Then Exit Sub
'ne tiens pas compte des mots entrés dans le tableau si ils sont positionnés en début
For I = 0 To UBound(TblNomsVides)
If TextBox1.Text = TblNomsVides(I) Then Exit Sub
Next I
'effectue la recherche et inscrit les résultats dans la ListBox
'attention, dans une plage, la recherche est faite par ligne (A2, B2, C2, etc... puis A3, B3, C3, etc...)
For Each Cel In Plage
'si il y a seuelement 2 lettres dans le TextBox, la recherche est faite avec ces
'deux lettres en début du texte contenu dans la cellule en cours
'sinon, la recherche est faite dans tout le texte contenu dans la cellule en cours
If Len(TextBox1.Text) < 2 Then
Chaine = TextBox1.Text & "*"
Else
Chaine = "*" & TextBox1.Text & "*"
End If
'avec un astérisque devant, le mot peut être au milieu du texte de la cellule
If Cel.Value Like Chaine Then
'évite de d'ajouter à nouveau le nom du film si une autre correspondance est trouvée sur la même ligne
If Cel.Row <> I Then
With ListBox1
.AddItem Plage(Cel.Row - 1, 1).Value 'récupére la valeur de la cellule A (je suppose que c'est le nom du film, à adapter)
.Column(1, .ListCount - 1) = Cel.Row 'mémorise le numéro de ligne
'si la correspondance est trouvée en colonne 1 (colonne A), ajoute la note 4 sinon, ajoute 1
'car trouvée ailleurs que dans le nom du film
If Cel.Column = 1 Then
.Column(2, .ListCount - 1) = "4" 'dans le nom du film
Else
.Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film
End If
End With
I = Cel.Row 'mémorise le numéro de ligne
'si c'est sur la même ligne...
Else
With ListBox1
If .ListCount > 0 Then
'mais pas dans le nom du film (pas initialisé), inscrit 1
If IsNull(.Column(2, ListBox1.ListCount - 1)) Then
.Column(2, ListBox1.ListCount - 1) = "1"
'sinon, inscrit 1 mais sépare avec une virgule
Else
.Column(2, .ListCount - 1) = .Column(2, .ListCount - 1) & ",1"
End If
End If
End With
End If
End If
Next Cel
End SubC'est génial, merci beaucoup. Pas besoin de beaucoup d'optimisation, notre but n'est pas de concurrencer Google
If Cel.Column = 1 Then
.Column(2, .ListCount - 1) = "4" 'dans le nom du film
Else
.Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film
End If
en ça :
If Cel.Column = 1 Then
.Column(2, .ListCount - 1) = "4" 'dans le nom du film
[u]Else If Cel.Column = 'numéro de la colonne' Then
.Column(2, .ListCount -1) = "4"
[/u]
Else
.Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film ou mots-clés
End If
Cest correct? Je suis débutant, mais c'est ce que j'ai cru comprendre, je me demande aussi si il ne manque pas un 2eme
dans mon changement?End If
Dans ce cas, je verrai plutôt un Select Case :
Select Case Cel.Column
Case 1: .Column(2, .ListCount - 1) = "4" 'dans le nom du film
Case 3: .Column(2, .ListCount - 1) = "4" 'si la colonne des mots clés est la 3 sinon adapter...
Case Else: .Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film ou la colonne des mots clés
End Selectà la place de :
If Cel.Column = 1 Then
.Column(2, .ListCount - 1) = "4" 'dans le nom du film
Else
.Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film
End IfEffectivement c'est plus court et plus lisible
Bonjour,
Si les deux colonnes ont la même valeur de point, on peut raccourcir de cette façon :
Select Case Cel.Column
Case 1, 3: .Column(2, .ListCount - 1) = "4" 'dans le nom du film et la colonne des mots clé
Case Else: .Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film ou la colonne des mots clés
End SelectPour une recherche adaptée à la frappe des lettres, je vous ai proposé la recherche sur l'évènement "Change" du TextBox mais si vous souhaiter un fonctionnement un peu comme Google ou autre, il est préférable d'utiliser un bouton afin que l'utilisateur puisse saisir tous ses mots clé avant d'effectuer la recherche.
Je me demandais justement si l'option du bouton ne serait pas plus pratique : notre base de donnée contiendra quelques dizaines de films, avec résumés.... La recherche n'est pas instantanée non? Et du coup si la recherche doit se faire chaque fois que l'utilisateur change un caractère dans la TextBox, est-ce qu'on ne risque pas d'avoir des problèmes de ralentissement?
Une autre question : sur notre UserForm2, on affiche les informations complètes sur le film (titre, producteur, résumé...), et deux problèmes se posent. La page est déjà faite, mais les informations sont affichées dans des TextBox, l'utilisateur peut supprimer le contenu. Est-il possible de faire l'équivalent mais sans que l'utilisateur puisse le modifier? Un peu comme une MsgBox mais intégrée à la page? Et deuxièmement, il me semblait qu'on pouvait régler une certaine largeur à notre TextBox (ou autre) où s'affichent les informations, et qu'on pouvait ajouter un retour à la ligne automatique une fois arrivé à cette taille limite.
Merci pour la rapidité et l'efficacité de vos réponses
Bonjour,
Voici un code pour la recherche suite au clic sur un bouton (nommé ici "CmdRecherche") :
Private Sub CmdRecherche_Click()
Dim Cel As Range
Dim I As Long
Dim J As Long
Dim TblNomsVides
Dim Chaine As String
Dim TblChaine
Dim Trouver As Boolean
Dim Adr As String
TblNomsVides = Array("et", "ou", "la", "le", "les", "car", "de", "du") 'etc...
'vide au préalable...
ListBox1.Clear
'evite de récupérer tous les films si le TextBox est vide
If TextBox1.Text = "" Then Exit Sub
'supprime les éventuels espaces parasites
Chaine = Replace(TextBox1.Text, " ", " ") 'triple (là c'est Parkinson)
Chaine = Replace(Chaine, " ", " ") 'double
Chaine = Trim(Chaine) 'de début et/ou de fin
'splite la chaine dans un tableau pour le bouclage
TblChaine = Split(Chaine, " ")
'vide pour la suite
Chaine = ""
'épure la chaine des mots inutiles (les noms vides)
For I = 0 To UBound(TblChaine)
For J = 0 To UBound(TblNomsVides)
If TblChaine(I) = TblNomsVides(J) Then
Trouver = True
Exit For
End If
Next J
If Trouver = False Then Chaine = Chaine & TblChaine(I) & "-"
Trouver = False
Next I
I = 0 'pour la suite
'supprime le tiret de fin
Chaine = Left(Chaine, Len(Chaine) - 1)
'splite à nouveau pour la recherche de chaque mot
TblChaine = Split(Chaine, "-")
'boucle sur la plage
For Each Cel In Plage
'puis sur le tableau afin de rechercher chaque mot
For J = 0 To UBound(TblChaine)
If Cel.Value Like "*" & TblChaine(J) & "*" Then
'évite d'ajouter à nouveau le nom du film si une autre correspondance est trouvée sur la même ligne
If Cel.Row <> I Then
With ListBox1
.AddItem Plage(Cel.Row - 1, 1).Value 'nom du film en colonne A
.Column(1, .ListCount - 1) = Cel.Row 'mémorise le numéro de ligne
Select Case Cel.Column
Case 1, 3: .Column(2, .ListCount - 1) = "4" 'pour le nom du film et la colonne des mots clé
Case Else: .Column(2, .ListCount - 1) = "1" 'ailleurs que dans le nom du film ou la colonne des mots clés
End Select
End With
End If
I = Cel.Row 'mémorise le numéro de ligne
End If
Next J
Next Cel
End SubDans l'UserForm2, pour éviter la suppression du texte dans les TextBox, mettre la propriété "Loked" à True, l'utilisateur peut sélectionner le texte mais pas le modifier.
Pour rendre tout le texte lisible dans le TextBox, mettre la propriété "MultiLine" à True et la propriété "ScrollBars" à 3 (fmScrollBarsBoth)
Bonjour,
Quand on utilise le code retravaillé, soit le code s'affiche entièrement en rouge, soit le DefPlage est surligné en jaune et ne fonctionne pas. Comment le corriger s'il vous plaît ? Ci-joint notre (début de) base de donnée, pouvez vous voir ce qui ne va pas?
De plus, on voudrait, pour la recherche, faire une recherche mot par mot si possible et pas combinée. Par exemple, lorsqu'on cherche "bruce die hard" aucun résultat n'est trouvé car aucune chaine de caractères ne correspond. Est-ce qu'il est possible de rechercher chaque mot individuellement, par exemple en considérant comme des mots différents tout ce qui est séparés par un espace?
Merci d'avance.
Bonjour,
Je re-poste le classeur avec le code pour la recherche dans l'UserForm1 (j'ai abandonnée la recherche sur 'lévènement "Change" du TextBox1)
Bonsoir, si vous avez un peu de temps à nous accorder, nous avons encore besoin de votre aide. Sur le UserForm2 s'affichent toutes les informations relatives au film choisi, et on essaie de rajouter l'image du film. Pour ça, on essaie de relier la ListBox du UserForm, pour que lorsque la personne clique sur le nom du film ça affiche l'image dans le UserForm2 en plus de charger celui-ci. Merci d'avance
Bonjour,
Sur l'évènement "Click" de la ListBox1. Les chemin complets (dossiers et nom de l'image) sont indiqués dans la colonne L. A adapter :
Private Sub ListBox1_Click()
Load UserForm2
'évite l'erreur de l'image manquante
On Error Resume Next
'le chemin des images des films sont indiqués en colonne L
With ListBox1
UserForm2.Image1.Picture = LoadPicture(Worksheets("Feuil1").Range("L" & .Column(1, .ListIndex)))
End With
UserForm2.Show
End Sub