XL 2010 recherche de mot sur plusieurs feuilles et non pas sur le classeur entier

THIRY

XLDnaute Nouveau
Bonjour à toutes et à tous
je cherche à modifier une macro de façon a faire une recherche sur une feuille ( index ) précise et pas sur le classeur entier.
merci beaucoup

Sub recherche(mot)
Dim plage As Range
ligne = 110
For Each ws In Sheets
If ws.Name <> "index" Then
For n = 1 To ws.Range("A65536").End(xlUp).Row
If InStr(UCase(ws.Range("a" & n)), UCase(mot)) <> 0 Then
Sheets("index").Cells(ligne, 1).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
ws.Name & "!a" & n, TextToDisplay:=ws.Range("a" & n).Value
ligne = ligne + 1
trouve = True
End If
Next n
End If
Next ws
If Not trouve Then MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
End Sub
 

laurent950

XLDnaute Accro
Bonsoir correctif du code suite au précision :

le mot rechercher : Exemple (plat)
La ligne 110 dans votre code (C'est pour faire des tests je pense)
en faite i est le compteur de la boucle donc pas besoin de Ligne (qui commence à 110)
Mais
CountRech = 1 (C'est la variable qui colle les valeurs par ordre dans la feuille recherche
de la première valeur trouvé à la dernière)
.ClearContents (effaces le contenu mais pas les formats ect.)
.Clear (Effaces tous ce qui se trouve dans la cellule)

VB:
Private Sub CommandButton1_Click()
reponse = InputBox("mot a chercher")
If reponse = "" Then
MsgBox ("Vous devez au moins mettre un mot !!!")
Exit Sub
End If
' Correction
' Range("A230:A" & Range("A250").End(xlUp).Row).ClearContents
' plage a effacer
Range("A1:A" & Range("A250").End(xlUp).Row).Clear
Call recherche(reponse)
End Sub

Puis correctif pour les liens hypertexte sur la Feuil recherche

VB:
Sub recherche(mot)
Dim ws As Worksheet
Set ws = Worksheets("index")
Dim plage As Range
'ligne = 110   / i c'est le compteur
' -----------------------------------
Dim wsRech As Worksheet
Set wsRech = Worksheets("recher")
Dim CountRech As Double
CountRech = 1
' -----------------------------------

For i = 1 To ws.Range("A65536").End(xlUp).Row
    If InStr(UCase(ws.Range("a" & i)), UCase(mot)) <> 0 Then
        wsRech.Cells(CountRech, 1) = ws.Cells(i, 1) 'ws.Cells(ligne, 1)  / i c'est le compteur
        wsRech.Cells(CountRech, 1).Hyperlinks.Add Anchor:=wsRech.Cells(CountRech, 1), Address:="", SubAddress:= _
        ws.Name & "!a" & i, TextToDisplay:=ws.Range("a" & i).Value
        'compteur de ligne "Boucle"
            ' ligne = ligne + 1 / i c'est le compteur
            CountRech = CountRech + 1
        ' Test
        trouve = True
    End If
Next i

If Not trouve Then
    MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
End If
End Sub

Laurent
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@THIRY
Reprécise exactement ton besoin stp
Est-ce tu veux chercher un mot dans dans toutes le feuilles du classeur (sans la feuille index) et afficher le résultat dans la feuille index en y ajoutant un lien hypertexte vers les occurrences trouvées?

Si oui, Excel sait déjà faire cela tout seul sans macro (avec CTRL+F)
01CTRLF.jpg
 

THIRY

XLDnaute Nouveau
Bonjour à tous,
Voilà où j'en suis et j'aimerais ajouter une feuille en plus "index" dans la recherche. de façon ç ce que la recherche se fasse sur : "index et donnees".
Merci

Sub recherche(mot)
Dim ws As Worksheet
Set ws = Worksheets("index")
Dim plage As Range
Dim wsRech As Worksheet
Set wsRech = Worksheets("recher")
Dim CountRech As Double
CountRech = 1

For i = 1 To ws.Range("A65536").End(xlUp).Row
If InStr(UCase(ws.Range("a" & i)), UCase(mot)) <> 0 Then
wsRech.Cells(CountRech, 1) = ws.Cells(i, 1)
wsRech.Cells(CountRech, 1).Hyperlinks.Add Anchor:=wsRech.Cells(CountRech, 1), Address:="", SubAddress:= _
ws.Name & "!a" & i, TextToDisplay:=ws.Range("a" & i).Value
CountRech = CountRech + 1
trouve = True
End If
Next i

If Not trouve Then
MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
End If
End Sub
 

THIRY

XLDnaute Nouveau
Bonsoir le fil, le forum

@THIRY
Reprécise exactement ton besoin stp
Est-ce tu veux chercher un mot dans dans toutes le feuilles du classeur (sans la feuille index) et afficher le résultat dans la feuille index en y ajoutant un lien hypertexte vers les occurrences trouvées?

Si oui, Excel sait déjà faire cela tout seul sans macro (avec CTRL+F)
Regarde la pièce jointe 1002879


Bonjour,
Dsl de na pas avoir répondu avant mais j'ai travaillé dessus sans grand résultats.
bien le code que vous m'avez donné fonctionne parfaitement c'est ce que je voulais mais entre temps j'aimerai pouvoir ajouter des feuilles comme "données" aussi je pensais :

Set ws = Worksheets("index", "donnees")

Mais pas de résultat voilà
Merci de votre patience :)
 

THIRY

XLDnaute Nouveau
Bonjour le fil, le forum

THIRY
J'attends toujours ta réaction sur le message#21
(C'est à dire la solution sans macro, comme sur la copie d'écran du dit message)
Bonjour Staple1600 et bonne année,
Concernat la boite de dialogue ( CTRL+F ) je nai aps du tout la même et elle ne me sert pas dans ce cas présent. la macro fonctionne très bien encore merci. elle affiche les cellules avec le mot rechercher et crée un lien .
mon envie etant de pouvoir ajouter une feuille dans la recherche : "index" et "donnee"
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

Copie ces code VBA et lances la macro test
VB:
Sub test()
recherche "toto"
End Sub
Private Sub recherche(mot)
Dim Sh As Worksheet, wsRech As Worksheet, CountRech&
Set wsRech = Worksheets("recher")
CountRech = 1
For Each Sh In Sheets(Array("Index", "Données"))
    For i = 1 To Sh.Range("A65536").End(xlUp).Row
        If InStr(UCase(Sh.Range("a" & i)), UCase(mot)) <> 0 Then
        wsRech.Cells(CountRech, 1) = Sh.Cells(i, 1)
        wsRech.Cells(CountRech, 1).Hyperlinks.Add _
            Anchor:=wsRech.Cells(CountRech, 1), _
            Address:="", _
            SubAddress:=Sh.Name & "!a" & i, _
            TextToDisplay:=Sh.Range("a" & i).Value
        CountRech = CountRech + 1
        trouve = True
        End If
    Next i
If Not trouve Then
MsgBox ("Pas de " & mot & " trouvé dans ce fichier")
End If
Next
End Sub
 

Discussions similaires

Réponses
7
Affichages
321

Statistiques des forums

Discussions
312 203
Messages
2 086 188
Membres
103 152
dernier inscrit
Karibu