comment faire une recherche dans tous les feuilles

[Thomas]

Bonsoir le forum,

suite à une reponse d'un precedent poste j'arrive à ouvrir des fichiers à partir d'excel, ce que je cherche à faire maintenant c'est faire une recherche par message box dans toutes les feuilles du fichier qui c'est ouver, j'ai vu comment faire une recherche dans des feuilles donc on connais le nom mais dans mon cas j'ouvre des fichiers avec des nom de feuille différente.

deplus tout les USF que j'ai vu tourné avec une fonction de recherche stoké les variables dans une feuille du dossier mais mois je veux rechercher dans un fichier X mais stoker mon historique dans mon fichier initial.

si je ne suis pas claire je peux poster un USF de recherche que j'ai trouvé sur ce forum car je me base sur celui la pour lui ajouter la fonction ouvir un autre fichier.

désolé si je ne suis pas claire mais il est tard

d'avance merci pour votre aide (je suis sur que cette trouvaille va intéréssé plein de monde car cela fait longtemps que je cherche sans trouver)

 

[CBernardT]

Bonjour Thomas et le forum,



Essayes cette macro :

Sub Chercher()
Dim i As Byte, j As Byte, K As Byte, X As Byte
Dim Cible As String
Dim Val As Object
Dim firstAddress As String, Resultat As String
Dim Tableau()

Application.ScreenUpdating = False
'Effacement des résultats précédents
Workbooks(1).Sheets(1).UsedRange.Offset(1, 0).ClearContents
'Mot à cherhcer
Cible = InputBox(' Saisir le mot à rechercher : ', 'Recherche', 'Le mot')
If Cible = '' Then Exit Sub
'Boucle avec affichage de tous les classeurs
For K = 1 To Workbooks.Count
Workbooks(K).Activate
'Boucle avec affichage de toutes les feuilles
For i = 1 To Sheets.Count
Sheets(i).Activate
With Sheets(i).UsedRange.Cells
Set Val = .Find(Cible, LookIn:=xlValues)
If Not Val Is Nothing Then
firstAddress = Val.Address
Do
Val.Select
'Mise en tableau des résultats trouvés
X = X + 1
ReDim Preserve Tableau(3, X)
Tableau(0, X - 1) = Workbooks(K).Name
Tableau(1, X - 1) = Sheets(i).Name
Tableau(2, X - 1) = 'Cellule ' & Val.Address
Set Val = .FindNext(After:=ActiveCell)
Loop While Not Val Is Nothing And Val.Address <> firstAddress
End If
End With
Next i
Next K
'Affichage des résultats sur le classeur et la feuille choisis
If X <> 0 Then
For j = 1 To X
Workbooks(1).Activate
Sheets(1).Activate
Range('A10000').End(xlUp).Offset(1, 0) = Tableau(0, j - 1)
Range('B10000').End(xlUp).Offset(1, 0) = Tableau(1, j - 1)
Range('C10000').End(xlUp).Offset(1, 0) = Tableau(2, j - 1)
Next j
End If
Application.ScreenUpdating = True
End Sub


A noter que le classeur de base (Celui qui contient les macros) est considéré comme le premier ouvert. Les autres sont ouverts avec la macro d'ouverture des classeurs contenue également dans le classeur de base tel que tu l'annonces.

La recherche est effectuée sur tous les classeurs y compris le classeur de base. Si cela n'est pas nécessaire, 'Caler la variable : K = 2 To Workbooks.Count

Cordialement

CBernardT

 

[Thomas]

Merci pour ton aide.

c'est vrais que faire une boucle sur les feuilles était la solution.

est il possible que le resulta de cette recherche ne s'affiche pas sur la premiere feuille mais sur une prés défini.

affin de recupérer celui ci pour allimenter un USF

merci d'avance

 

[CBernardT]

Re Thomas

L'affichage peut être effectué o&ugrave; tu le souhaites !

Il suffit de changer les chiffres 1 par les noms du classeur et de la feuille comme par exemple :

Workbooks('Classeur1').Activate
Sheets('Base').Activate
Range('A10000').End(xlUp).Offset(1, 0) = Tableau(0, j - 1)
Range('B10000').End(xlUp).Offset(1, 0) = Tableau(1, j - 1)
Range('C10000').End(xlUp).Offset(1, 0) = Tableau(2, j - 1)

Salut

CBernardT

 

[Thomas]

Merci Bernard,

en fait dans mon poste précise au debut que je souhaite faire une recherche dans x fichier xls ce qui fait me mon dossier actif sera celui que j'aurai ouvert grace à ma macro.

de ce fait je pense que la feuille qui devrait etre allimenté par la recherche devrait étre sur le fichier.xls qui contient la macro.

est il possible de dire 'recherche feuille active' (donc ca pas de problème) mais comment faire pour qu'il cré le resulta dans le fichier qui n'est plus actif en l'applant par son nom?

Merci
Thomas

 

[CBernardT]

Re Thomas

Je ne sais pas si tu as lu mon dernier post mais je t'y donne la solution ?

A noter qu'en début de la macro, si tu veux effacer la zone de résultat avant d'y replacer le résultat suivant, il faut faire de même.

'Effacement des résultats précédents
Workbooks(('Classeur1').Sheets(('Base').UsedRange.Offset(1, 0).ClearContents

Salut

CBernardT

 

[_Thierry]

Bonjour Thomas, CbernardT, le Forum

Pour Thomas, si tu dois ré-activer le Calsseur contenant la macro en cours d'éxécution ceci suffit :

ThisWorkbook.Sheets('Feuil1').Activate

Maintenant, l'idéal serait plutot d'en faire un Objet

Dim WSBase As Worksheet
Set WSBase = ThisWorkbook.Sheets('Feuil1')
WSBase.Range('A1') = 'TOTO'

Si ça peut t'aider car là tu pourras faire instance à WSBase, VBA saura de quel classeur et feuille il s'agit...

Sinon pour Bernard, j'ai juste survolé le code proposé, et trois trucs m'interpellent :

1) Val comme nom de Variable, autant que possible ne jamais donner un nom de variable existant en tant que Méthode ou Fontion dans VBA, En l'occurrence Val est une Fonction qui renvoie le nombre contenu dans une chaîne de caractère sous la forme d'une valeur numérique d'un type approprié. J'avais (je crois bien me souvenir) 'attrapé MichelXLD pour exactement la même Val !!!

2) Val As Object, en fait dans un .Find la variable retournée est certe un Object, mais un Object Range, donc on gagnera en précision en déclarant Val As Range, et vu que çà n'a rien à voir avec une 'Valeur', tant qu'à faire la nommer 'C' ou encore 'Cell'.

3) Dim Tableau() en Base Zéro, Base zéro est implicite par défaut si on indique rien, et par conséquent ton Tableau démarrera de 0,0 et pas de 1, tu as du le voir et c'est pour ceci cette gymnastique 'Tableau(0, X - 1)'...

En fait il suffit d'incrémenter ton 'X' en fin de traitement, et tu n'auras pas ce problème :

ReDim Preserve Tableau(3, X)
Tableau(0, X) = Workbooks(K).Name
Tableau(1, X) = Sheets(i).Name
Tableau(2, X) = 'Cellule ' & Val.Address
X = X + 1

C'est bien plus simple et lisible, chose très importante dans des applis entrecroisant plein de tableau, faut s'y retrouver d'un clin d'oeil.

Voilà juste des conseils basics pour avoir de bonnes habitudes de base, sans prétentention aucune.

Bon Dimanche
@+Thierry

 

[Thomas]

Bonjour _Thierry, CbernardT, le Forum


Merci pour vos réponses.

je vais les essayer ce soir.

Thomas

 

[CBernardT]

Re à thomas et Bonjour à Thierry

Pour Thierry,

Bien vu et merci pour tes modifs. Je n'ai pas l'informatique infuse, c'est pourquoi tous les bons conseils échangés sur ce forum sont les bien venus et tout particulièrement les tiens.

Pour Thomas, afin de présenter un code 'propre', je remets la macro corrigée en option base 1. Il est évident que beaucoup d'amélioration du code pourrait être apportées si un modèle du classeur souhaité avait été mis en pièce jointe.

Option Explicit
Option Base 1
Sub Chercher()
Dim i As Byte, j As Byte, K As Byte, X As Byte
Dim Cible As String
Dim Cell As Range
Dim firstAddress As String, Resultat As String
Dim Tableau()

Application.ScreenUpdating = False
'Effacement des résultats précédents
Workbooks(1).Sheets(1).UsedRange.Offset(1, 0).ClearContents
'Mot à cherhcer
Cible = InputBox(' Saisir le mot à rechercher : ', 'Recherche', 'Le mot')
If Cible = '' Then Exit Sub
'Boucle avec affichage de tous les classeurs
For K = 1 To Workbooks.Count
Workbooks(K).Activate
'Boucle avec affichage de toutes les feuilles
For i = 1 To Sheets.Count
Sheets(i).Activate
With Sheets(i).UsedRange.Cells
Set Cell = .Find(Cible, LookIn:=xlValues)
If Not Cell Is Nothing Then
firstAddress = Cell.Address
Do
Cell.Select
'Mise en tableau des résultats trouvés
X = X + 1
ReDim Preserve Tableau(3, X)
Tableau(1, X) = Workbooks(K).Name
Tableau(2, X) = Sheets(i).Name
Tableau(3, X) = 'Cellule ' & Cell.Address
Set Cell = .FindNext(After:=ActiveCell)
Loop While Not Cell Is Nothing And Cell.Address <> firstAddress
End If
End With
Next i
Next K
'Affichage des résultats sur le classeur et la feuille choisis
If X <> 0 Then
For j = 1 To X
Workbooks(1).Activate
Sheets(1).Activate
Range('A10000').End(xlUp).Offset(1, 0) = Tableau(1, j)
Range('B10000').End(xlUp).Offset(1, 0) = Tableau(2, j)
Range('C10000').End(xlUp).Offset(1, 0) = Tableau(3, j)
Next j
End If
Application.ScreenUpdating = True
End Sub

Cordialement

CBernardT

 

[Thomas]

Merci à vous pour votre aide.

Thomas