[XL-2010] Macro qui recherche par mot clé

[Adrien13]

Bonjour à tous,
Voilà mon problème. Je souhaiterai mettre en place un fichier qui regroupe des liens vers des fichiers. Il y a plusieurs feuilles (chaque feuille représente un thème). A l'ouverture du fichier, il demande quel fichier est recherché. Ensuite il affiche le(s) résultat(s) directement. Ça ressemble à un ctrl +f, sauf que ça regroupe les résultats sur une nouvelle feuille.

J'ai trouvé un code qui marche pour un mot, mais j'aimerai pouvoir faire mes recherches depuis des mots clés.

Ci-dessous le code que j'aimerai optimiser:

Code :

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
43
44
45
46
47
48
Sub Recherche()
Dim RechNom As String, firstAddress As String
Dim i As Byte, derlign As Long, derLignTemp As Long
Dim c As Range
 
    RechNom = InputBox("Quelle est votre recherche ?")
    Sheets("Résultats").[G1] = RechNom
    RechNom = Sheets("Résultats").[G1]    'adresse du nom que l'on recherche
    If RechNom = "" Then MsgBox "Pas de nom saisi", vbInformation: Exit Sub
    derlign = Sheets("Résultats").[A65536].End(xlUp).Row
    If derlign > 0 Then Range("B1:J" & derlign).ClearContents    'on efface la liste des résultats avant de commencer la recherche
    For i = 1 To Sheets.Count    'on boucle sur toutes les feuilles à partir de la 1er
        derlign = Sheets(i).Range("B65536").End(xlUp).Row
        With Sheets(i).Range("B1:C" & derlign)
            Set c = .Find(RechNom, LookIn:=xlValues, LookAt:=xlPart)    'on effectue la recherche avec la méthode Find
'           Stop
            If Not c Is Nothing Then
               'Stop
                firstAddress = c.Address
                Do
                    With Sheets("Résultats")
                        derLignTemp = .Range("A65536").End(xlUp).Row + 1
                        'on inscrit les résultats de la recherche dans la feuille Résultats
                        '.Range("G" & derLignTemp) = c.Offset(, -1)
                        .Range("A" & derLignTemp) = c.Value
                        .Range("I" & derLignTemp) = c.Offset(, 1)
                        .Range("J" & derLignTemp) = c.Offset(, 2)
 
                    End With
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next i
'   Stop
   temp = Cells(2, 1).Value
    If derLignTemp = 0 Then rep = MsgBox("La réponse n'est pas la !", vbOKOnly)
       If rep = 1 Then Exit Sub
    'End If
 
    Sheets("Résultats").Activate
Range("A" & derLignTemp).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "affichage_mails_outlook_2010.doc"
    ActiveWindow.SmallScroll ToRight:=1
    Range("A1").Activate
 
End Sub

Merci d'avance pour votre aide.

[Jean-Pierre49]

Bonjour

Peut être une piste

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim Plage As Range
Dim Cell As Range
 
 Set Plage = Sheets(i).Range("B1:C" & derlign) 'déclaration du tableau
 For Each Cell In Plage ' recherche dans chaque cellule du tableau
 
    If Cell Like RechNom Then ' si Cell contient RechNom
 
 
    Else
 
    End If
 
 Next Cell

bon courage