Module de recherche élaboré

[toine2010]

Bonjour,
J'ai profité depuis longtemps des trucs et astuces savamment distillés sur le forum mais là je suis bloqué...
Jusqu'à présent j'avais un fichier excel avec un module de recherche qui permettait de chercher des mots clés dans d'autres onglets et de générer des liens hypertexte pour y accéder et tout fonctionnait très bien...
Je souhaite maintenant pouvoir faire une recherche "multi critère", c'est à dire je tape dans le module chèvre cheval et il me crée un lien hypertext vers toutes les cellules qui contiennent les mots chèvre et cheval, hélas aujourd'hui ça ne fonctionne pas car je n'arrive pas à lui faire également identifier la cellule qui contient cheval chèvre (ordre inversé) et lorsqu'il y a de la ponctuation (,) ça ne fonctionne pas...
En prime je souhaiterais qu'il ne fasse pas de distinction entre chèvre et chevre, c'est à dire qu'il ne prenne pas en compte les accents...
Je vous joins mon fichier de travail, si quelqu'un pouvait m'aider ça serait très sympa
A+

 

[jp14]

Re : Module de recherche élaboré

Bonsoir

Une piste
Si on doit trouver les lignes qui ont les deux mots, on fait la recherche avec un seul mot et ensuite avec "INSTR" on vérifie si le deuxième mot est présent dans la cellule , par cette méthode l'ordre n'a pas d'importance.

JP

 

[david84]

Re : Module de recherche élaboré

Bonsoir, jp14,
ci-joint une proposition à tester.
Possibilité de rentrer un ou plusieurs mots.
Si plusieurs mots : espace entre chaque (mouton cheval vache)
Le reste (lien hypertexte, accentuation, ponctuation,...) n'est pas traité pour l'instant.

Sub filtrer()
Dim a, c, reponse As String, i&, j&, k&, l&, Nb&, Pl As Range
On Error GoTo Erreur
Sheets("RésultatRecherche").Range("A6:A100").ClearContents

With Sheets("REGQSA")
    Set Pl = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

reponse = InputBox("Texte ou expression à rechercher")

a = Split(reponse)

Dim b(), d()
ReDim b(1 To Pl.Rows.Count)
    For i = 1 To Pl.Rows.Count
        b(i) = Replace(Pl(i), ",", "")
    Next i
l = 1
For i = LBound(b) To Pl.Rows.Count
    c = Split(b(i))
    For j = LBound(a) To UBound(a)
        For k = LBound(c) To UBound(c)
            If a(j) = c(k) Then
                Nb = Nb + 1: Exit For
            End If
        Next k
    Next j
    
    If Nb = UBound(a) + 1 Then
        ReDim Preserve d(1 To l)
        d(l) = b(i): l = l + 1
    End If
    Nb = 0
Next i
Sheets("RésultatRecherche").Range("A6").Resize(UBound(d)) = Application.Transpose(d)
Exit Sub
Erreur:
MsgBox "chaîne de caractère inconnue"
End Sub

A+

 

[toine2010]

Re : Module de recherche élaboré

Merci David,
Au niveau de la recherche multi mots, ça marche nickel! J'ai maintenant un peu de mal à venir y réintégrer la macro d'origine avec les liens hypertexte et j'ai trouvé ce morceau de macro pour gérer les accents mais même chose, pour l'intégrer dans la macro initiale!...
A+

Function ch_sans_accent(ch_characters As Range)
liste_accents = "ÉÈÊËÔéèêëàçùôûïî"
liste_sans_accents = "EEEEOeeeeacuouii"
tempo = ch_characters.Value
For i = 1 To Len(tempo)
s = InStr(liste_accents, Mid(tempo, i, 1))
If s > 0 Then Mid(tempo, i, 1) = Mid(liste_sans_accents, s, 1)
Next
ch_sans_accent = tempo
End Function

 

[david84]

Re : Module de recherche élaboré

Re
je ne connais pas ton fichier original donc difficile pour moi de porter un jugement mais peut-être qu'il ne faut pas à tout prix reprendre ta macro d'origine (je dis bien peut-être !).
Pour le reste, procédons par étape :
concernant une recherche non accentuée, teste ceci :

Sub filtrer()
Dim A, c, reponse As String, i&, j&, k&, l&, Nb&, Pl As Range
On Error GoTo Erreur
Sheets("RésultatRecherche").Range("A6:A100").ClearContents

With Sheets("REGQSA")
    Set Pl = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

reponse = InputBox("Texte ou expression à rechercher")
reponse = Sans_accents(reponse)
A = Split(reponse, ",")

Dim B(), d()
ReDim B(1 To Pl.Rows.Count, 1)
    For i = 1 To Pl.Rows.Count
        B(i, 0) = Replace(Sans_accents(Pl(i)), ",", "")
        B(i, 1) = Pl(i)
    Next i
l = 1
For i = LBound(B) To Pl.Rows.Count
    c = Split(B(i, 0))
    For j = LBound(A) To UBound(A)
        For k = LBound(c) To UBound(c)
            If A(j) = c(k) Then
                Nb = Nb + 1: Exit For
            End If
        Next k
    Next j
    
    If Nb = UBound(A) + 1 Then
        ReDim Preserve d(1 To l)
        d(l) = B(i, 1): l = l + 1
    End If
    Nb = 0
Next i
Sheets("RésultatRecherche").Range("A6").Resize(UBound(d)) = Application.Transpose(d)
Exit Sub
Erreur:
MsgBox "chaîne de caractère inconnue"
End Sub
Function Sans_accents(Chaine As String) 'http://www.generation-nt.com/reponses/comment-remplacer-caractere-accentue-par-non-accentue-e-mails-entraide-3563901.html
Dim T As String, A As String, B As String
Dim i As Integer, U As String
If Chaine = "" Then Exit Function
T = Chaine
'remplacement des caractères accentués
A = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿçÇ"
B = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyycC"
For i = 1 To Len(T)
U = InStr(1, A, Mid(T, i, 1), 0)
If U Then Mid(T, i, 1) = Mid(B, U, 1)
Next i
Sans_accents = T
End Function

Concernant le remplissage de ton InputBox, pour l'instant le caractère d'espacement entre chaque mot doit être respecté mais si tu préfères remplacer l'espace par une virgule c'est bien sur jouable : modifier au niveau de la fonction split en indiquant le caractère choisi.
Pour le lien hypertexte, on voit cela après, mais tu peux déjà remarquer que ce nouveau code ramène les lignes telles qu'elles sont orthographiées dans la feuille REGQSA, ce qui me semble indispensable à la constitution du lien hypertexte.
Ceci-dit, je n'ai pas compris vers quoi ton lien hypertexte devait pointer (quand tu cliques dessus, tu dois te retrouver où ?).
A+

 

[Staple1600]

Re : Module de recherche élaboré

Bonjour à tous

Pour le plaisir de croiser david84
(Pendant que je suis là, une tite question
Peux-tu me dire, stp, si cela fonctionne (j'ai la flemme de tester ce matin)

A = Split(Sans_accents(InputBox("Texte ou expression à rechercher")), ",")

 

[toine2010]

Re : Module de recherche élaboré

Re,
Rassure toi je ne suis pas du tout attaché à la macro d'origine!!
Le code qui élimine les accents fonctionne il trouve bien chevre mais la recherche multi mots ne fonctionne plus, il ne trouve plus chevre (ou chèvre) cheval.
Pour la description de mon fichier d'origine : j'ai plusieurs feuilles et dans chaque feuille plusieurs colonnes qui contiennent du texte. L'idée est de faire la recherche des mots colonne par colonne et feuille par feuille et d'afficher les résultats sous forme de lien hyper texte qui pointe sur la cellule qui contient les mots recherchés...
Si tu veux, voilà le fichier un peu plus détaillé

 

[david84]

Re : Module de recherche élaboré

Re

Le code qui élimine les accents fonctionne il trouve bien chevre mais la recherche multi mots ne fonctionne plus, il ne trouve plus chevre (ou chèvre) cheval.

une petite coquille dans le code au niveau de

A = Split(reponse, ",")

Remplacer cette ligne par

A = Split(reponse)

.
Sais-tu tester un code en pas à pas ?
Si tu l'avais fait tu aurais corrigé toi-même cette erreur (si tu ne le sais pas , je t'encourage à effectuer une recherche à ce sujet).
Pour le reste, je vais regarder ton fichier.

@staple : bonjour mon ami. Alors la flemme ce matin ?
Je teste et te dis.
A+

 

[david84]

Re : Module de recherche élaboré

Re staple,

A = Split(Sans_accents(reponse))

(avec l'espace pour le delimiter pour l'instant) fonctionne selon mes 1er tests (mais j'ai l'impression que tu avais déjà ton avis sur la question ).
A+

 

[Staple1600]

Re : Module de recherche élaboré

Re à tous,

David84:
Oui j'ai passé une tite nuit à cause de Joachim
J'ai le neurone lâche ce matin, et la guibole molle

Mais bon comme je t'aime bien toi et ton XLD's posting style, je vais ouvrir le xlsm (bien que j’eusse préféré que le demandeur joigne plutôt un xls pour atteindre un plus grand nombre de membres d'XLD, mais comme dirait une autre perle d'XLD: "autant pratiquer la miction dans un violon" - bon c'est vrai il le dit plus crument- alors j'ai traduit en américain politiquement correct)

Et je vais tester par moi-même ton joli code qui a mis un sourire au coin de l’œil torve qui lit XLD pendant que l'autre regarde un truc de la télé en replay.

EDITION: Je viens de tester

A = Split(Sans_accents(InputBox("Texte ou expression à rechercher")), ",")

Cela fonctionne
Ceci dit, deux choses m'intriguent ici bas
1) Pourquoi le ciel est bleu ?
2) Pourquoi la PJ du demandeur pèse 275 ko ?

 

[david84]

Re : Module de recherche élaboré

Re toine 2010,
tu aurais dû fournir ce fichier dès le départ car en fonction de la problématique, l'angle d'attaque de la proposition ne sera pas le même.
Dois-tu rechercher uniquement dans la colonne Titre de chaque feuille ou sur toutes les colonnes (comme je crois le comprendre mais je préfère m'en assurer).
A première vue tu devrais arriver à tes fins comme cela :
- boucler sur toutes les feuilles en excluant RésultatRecherche
- redéfinir Pl sur chaque feuille via un CurrentRegion redimensionné pour ne pas prendre en compte la ligne d'entêtes
- inclure une boucle supplémentaire dans le tableau B pour boucler sur les différentes colonnes de chaque feuille
Le reste devrait suivre.
Dis-nous où tu bloques.

@staple : super ! Plus on est de fous...
A+

 

[Staple1600]

Re : Module de recherche élaboré

Re à tous


• David84
Moi qui vient de louer ton syle XLDien
Qu'apprends-je ! Toi aussi tu coquilles, parfois !
Ce faisant tu m'obliges à faire 2 tests (moi qui fatigue si vite ce matin)

A = Split(Sans_accents(InputBox("Texte ou expression à rechercher")))

fonctionne lui aussi
[humour foireux]
David84, n'essaies tu pas de me rendre chèvre par hasard ? Maman m'avait bien prévenu
Les chats ne font pas des chiens.
[/humour foireux]

PS: je reste toujours intrigué par la taille conséquente de la PJ (qui au passage aurait pu être zippé )

• Demandeur (AKA toine2010)
Si jamais tu lis mon passage sur le xls vs xlsm, tire en les conséquences (ou pas).

 

[toine2010]

Re : Module de recherche élaboré

Re david84,
Désolé, j'avais d'abord fourni une partie tronquée du fichier...
Effectivement, je souhaite rechercher dans toutes les colonnes pour chaque page.

Pour Staple 1600,
Je te laisse basculer le fichier en xls si tu y tiens!

 

[david84]

Re : Module de recherche élaboré

Re
@staple : t'inquiète, j'avais testé dès le départ (avec Jean-Noël, niveau imbrication à tout-va, j'ai été à bonne école) mais ne connaissant pas le niveau VBA de notre ami, j'ai préféré procédé par étape mais je vois qu'au moins tu as testé !

@toine 2010 : ci-joint un fichier en .xls (staple a raison : cela permet à plus de monde de participer et augmente tes chances de te voir proposer des possibilités).
Recherche effectuée sur toutes les colonnes de toutes les feuilles, à tester plus avant.
Les lien hypertextes ne sont pas réglés (mais peut-être sais-tu régler cette partie de la procédure ?).
A+

 

[toine2010]

Re : Module de recherche élaboré

Merci bcp! Ca répond quasi complètement à mon besoin...
Petite question : la recherche se fait par ligne, quand on tape un mot, il va rechercher le mot (ou expression)dans chaque cellule de chaque ligne (recherche sur ligne 1, 2...), je souhaiterais qu'il aille chercher le mot dans chaque colonne (rechercher sur colonne A, B, ...). Cela me permet de prioriser la recherche, les éléments présents dans la colonne A sont plus importants que ceux dans la colonne B... Donc l'idéal c'est que l'on ait en affichage d'abord les informations trouvées dans la colonne A, puis B...J'ai du mal à changer la boucle qui scanne chaque ligne par une boucle qui scanne chaque colonne.

Concernant les liens hyper texte, j'utilisais ce morceau de code trouvé sur le forum, reste à l'intégrer correctement dans tes multiples boucles! J'avoue que là ça me dépasse un peu...
A+

For Each ws In Sheets
If ws.Name <> "RésultatRecherche" Then
With ws.Cells
Set c = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
Sheets("RésultatRecherche").Cells(ligne, 1).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ws.Name & "!" & c.Address, TextToDisplay:=c.Value
Selection.WrapText = False
ligne = ligne + 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