[VBA] Moteur de recherche [Résolu]

KuZ

XLDnaute Nouveau
Bonjour,

Dans le cadre professionnel, il m'a été confié un projet, créer une base de données Excel. Pour un soucis de confidencialité, je ne me pencherais pas plus sur le sujet.
La création de la base a pris beaucoup de temps, et surtout son remplissage fut exténuant.

Je suis presque à la date butoire pour la remise du projet, et il me manque la mise en place d'un moteur de recherche fonctionnel.
Je me suis mis à l'apprentissage du VBA afin de réaliser un code valable. Mais la complexité et la dureté de compréhension du VBA m'a poussé vers du bricolage de code. (Je commence à comprendre un peu la logique du code mais pas plus...)

Le sujet:

A partir d'un mot ou un numéro, et grace à un code VBA de comparaison (moteur de recherche), une liste de résultats s'affiche.
Ces résultats seront des liens hypertext qui pointeront vers l'adresse de la cellule, dont sa valeur est égale ou contient une partie du mot ou du numéro recherché.


Mes débuts de solutions:

Une feuille "Search Engine", est dédiée pour les résultats du moteur de recherche.
Sur cette même feuille, il y a deux boutons.
L'un est un effacement des résultats:
Code:
Sub effacer_plage()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.Interactive = False
    If MsgBox("Etes-vous certain de vouloir supprimer le contenu des résultats ?", vbYesNo, "Demande de confirmation") = vbYes Then
        Range("A9:A65536").ClearContents
        MsgBox "Le contenu des résultats a été effacé !"
    End If
Range("A4").Select
Application.Interactive = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

L'autre fait appel à une inputbox afin de récupérer le mot ou numéro a recherché, puis fait appel à une fonction de recherche (que j'ai copié d'une des réponse d'aides pour un autre topic):
Code:
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.Interactive = False
reponse = InputBox("Veuillez saisir la référence ou le nom de l'article ?", "Recherche d'articles")
Call recherche(reponse)
Range("A4").Select
Application.Interactive = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Enfin, là où se pose tout mon problème (enfin je crois), c'est cette fonction de recherche.
Je fait une recherche dans une feuille précise de mon classeur.
Je définis une plage de cellules dans laquelle faire la recherche.
Et puis les résultats s'affichent sous forme de liens hypertext (hypothèse).

Et le résultat, c'est que rien ne s'affiche.

Voila le code:
Code:
Sub recherche(mot)
On Error GoTo fin
ligne_r = 9
For Each ws In Sheets
If ws.Name = "Capacité - Capacities" Then
Set maplage = Worksheets("Capacité - Capacities").Range(Cells(1, 1), Cells(65536, 2))
With maplage
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Sheets("Moteur de recherche").Cells(ligne_r, 1).Select
         Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & ws.Name & "'!" & c.Address, TextToDisplay:=c.Value
          ligne_r = ligne_r + 2
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
      trouve = True
    End If
End With
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
fin:
End Sub

Par contre modifant le code , en enlevant la délimitation de la plage, la recherche se fait bien par mot avec un affichage des résultats (en lien hypertext).
Cependant la recherche n'est concluante qu'avec qu'avec des mots. Pour les numéros il ne se passe rien.
Exemple du code:
Code:
Sub recherche(mot)
On Error GoTo fin
ligne_r = 9
For Each ws In Sheets
If ws.Name = "Capacité - Capacities" Then
With ws.Cells
Set c = .Find(What:=mot, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Sheets("page d'ouverture").Cells(ligne_r, 1).Select
         Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
          ws.Name & "!" & c.Address, TextToDisplay:=c.Value
          ligne_r = ligne_r + 1
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
      trouve = True
    End If
End With
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
fin:End Sub

Je tiens à préciser que les cellules dans tout le classeur sont définies en standard.

Je me tiens à votre disposition pour des questions que vous vous poseriez.

Merci pour votre aide,

KuZ
 
Dernière édition:

fredl

XLDnaute Impliqué
Re : [VBA] Moteur de recherche

Bonjour,
peux tu nous fournir ton fichier avec le code et en supprimant tes données confidentielles?
mettre qqs exemples concrets du type toto, etc avec un exemple fonctionnel(mot)et un exemple bloquant(chiffre)?
Cdt
Frédéric
 

KuZ

XLDnaute Nouveau
Re : [VBA] Moteur de recherche

Bonjour,

Voila le petit exemple. Par contre j'ai du faire de la place donc vous n'avez que les grandes lignes du fichier (le code et les deux feuilles concernés par le code).

Amicalement,

KuZ

-------------
Re Bonjour,

Je modifie mon dernier message afin de vous montrer une avancée.

J'ai modifié le code de la fonction recherche, en ciblant la feuille dans laquelle je veux que les recherches se fassent.
De même, j'ai réussi à définir une plage de valeurs dans laquelle faire la recherche.
Code:
Sub recherche(mot)
On Error GoTo fin
ligne = 9
Set ws = Worksheets("Capacité - Capacities")
With ws.Range("A10:B65536")
    Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Sheets("Moteur de recherche").Cells(ligne, 1).Select
         Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & ws.Name & "'!" & c.Address, TextToDisplay:=c.Value
          ligne = ligne + 2
          Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
      trouve = True
    End If
End With
If Not trouve Then MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
fin:
End Sub

Le problème reste pourtant le même qu'avant, une recherche par mots clés se réalise avec résultats ou message d'erreur si les mots clés ne sont pas retrouvés.
Et une recherche par numéro ne s'effectue pas, donc pas de résultats, et surtout pas de message d'erreur pour dire que le numéro n'est pas contenu dans la plage a vérifier.

J'ai aussi tester l'astuce de l'étoile * en le marquant a la fin de la saisie de l'input box mais rien n'y fait ça ne marche pas.

Je continue à chercher, et vous ferai suite des mes trouvailles.

Amicalement,

KuZ
 

Pièces jointes

  • [VBA]Recherche_KuZ.xls
    172.5 KB · Affichages: 231
Dernière édition:

fredl

XLDnaute Impliqué
Re : [VBA] Moteur de recherche

J'ai peut etre qqe chose...
Teste le fichier joint et recherche le chiffre 1


j'ai rajouté le "" vers la fin de l'instruction afin de "leurer" le chiffre qui devient reconnu en texte. Il est alors affiché...

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & ws.Name & "'!" & c.Address, TextToDisplay:="" & c.Value

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Dis moi!

A+
Frederic
 

Pièces jointes

  • Recherche_KuZ(1).xls
    170 KB · Affichages: 336

KuZ

XLDnaute Nouveau
Re : [VBA] Moteur de recherche

Bonjour fredl,

Je te remercie pour ton aide, cela marche bien, et surtout comme je le souhaite.

Par contre, en demandant de l'aide à l'un de mes professeurs la semaine dernière, il m'a presque donné la même solution:

Code:
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & ws.Name & "'!" & c.Address, TextToDisplay:="'" & c.Value

En tout cas merci pour ton aide et aux autres membres du forum qui s'y seront essayé mais n'auront pas trouvé de solution.

Bonne journée
 

Discussions similaires

Réponses
7
Affichages
292
Réponses
8
Affichages
447
Réponses
12
Affichages
537