Microsoft 365 Effectué une recherche dans plusieurs fichiers

largo41270

XLDnaute Nouveau
Bonjour a tous

J’ai besoin de votre aide

Je dois effectue une recherche dans plusieurs fichiers excel (environ 20 fichiers) comportant 15 colonnes.

Imaginons que dans tous les fichiers source que la colonne M soit les n° de palettes et en R les n° de pièce

Je voudrais pouvoir effectuer la recherche soit par une partie du n° de palette ou du n° de la pièce et Afficher la ligne complète du fichier dans le cadre résultat et si je clic sur le résultat ca ouvre le fichier

En bas de la feuille j’ai mis des modèles de N° de pièce on constate qu’il y a des parties identique

Pour éviter que ça ram de trop dans le fichier j’ai fait une liste des dossiers ou je dois chercher

Et cellule G4 j’indique dans quel dossier chercher

Je reste a votre disposition et vous remercie d’avance
 

Pièces jointes

  • Classeur2.xlsm
    15 KB · Affichages: 8

largo41270

XLDnaute Nouveau
bonjour wtf merci de ta réponse.

il y a minimun 20 fichiers par dossiers et environ 30 dossiers

j'ai trouvé un fichier qui pourrait faire le travail , je n'arrive pas a le modifier , je suis trop nul

le fichier liste tous les dossiers dans la colonne a ( pas besoins)
et affiche le résultat dans une box avec le chemin du dossier, moi je voudrais que la ligne complète s'affiche sur ma feuille et en cliquant sur cette ligne ca ouvre le fichier.

en Piece jointe fichier et dossiers j'ai mis le code d'origine (des que je modifies un truc ca bug pufffffff

merci d'avance
 

Pièces jointes

  • test recherche.zip
    35.5 KB · Affichages: 6

largo41270

XLDnaute Nouveau
bonjour a tous,

je ne connais rien en vba j'ai téléchargé plein de code concernent la recherche dans plusieurs fichiers impossible de les adaptés

je cherche un code simple

1 classeur principal avec un bouton pour lancer la recherche le mot situé en "B4" dans la colonne "F"sur tous les fichiers d'un dossier (chemin indiqué en "f4") et qu'il affiche a partir de la ligne 15 du fichier principal toutes les lignes des fichiers ou il a trouvé un resultat en colonne "F"

merci d'avance a tous
 

Staple1600

XLDnaute Barbatruc
Bonjour @largo41270, @WTF, le fil

Je plussoie à l'idée de @WTF
Donc avec PowerQuery
(en faisant Obtenir des données/A partir d'un fichier/A partir d'un dossier)
Ci-dessous les étapes récupérées dans PowerQuery (avec l'éditeur avancé)
PowerQuery:
let
// ici il faut changer le chemin du dossier avec celui qui est sur ton PC
    Source = Folder.Files("C:\Users\STAPLE\Downloads\test recherche"),
    #"Lignes filtrées" = Table.SelectRows(Source, each ([Extension] = ".xls")),
    #"Fichiers masqués filtrés1" = Table.SelectRows(#"Lignes filtrées", each [Attributes]?[Hidden]? <> true),
    #"Appeler une fonction personnalisée1" = Table.AddColumn(#"Fichiers masqués filtrés1", "Transformer le fichier", each #"Transformer le fichier"([Content])),
    #"Colonnes renommées1" = Table.RenameColumns(#"Appeler une fonction personnalisée1", {"Name", "Source.Name"}),
    #"Autres colonnes supprimées1" = Table.SelectColumns(#"Colonnes renommées1", {"Source.Name", "Transformer le fichier"}),
    #"Colonne de tables développée1" = Table.ExpandTableColumn(#"Autres colonnes supprimées1", "Transformer le fichier", Table.ColumnNames(#"Transformer le fichier"(#"Exemple de fichier"))),
    #"Type modifié" = Table.TransformColumnTypes(#"Colonne de tables développée1",{{"Source.Name", type text}, {"date de commande", type date}, {"date de livraison", type date}, {"numero de palette ", type text}, {"ref article", type text}, {"n° de serie ", type text}, {"Column6", type text}}),
    #"Colonnes supprimées" = Table.RemoveColumns(#"Type modifié",{"Column6"})
in
    #"Colonnes supprimées"
Voila ce que j'obtiens (image1: les données brutes, image2: données filtrées)
importPQ.PNG
Ensuite j'ai ajouté une petite macro pour filtrer
(équivaut au filtre automatique -> Contient)
(*) Ici il y a deux filtres (un avec le bouton et l'autre manuel sur les dates de commande où je filtre que sur l'année 2022

PQ_Filter.PNG
Ci-dessous la macro associée au bouton
VB:
Private Sub CommandButton1_Click()
ActiveSheet.ListObjects("test_recherche").Range.AutoFilter _
Field:=4, Criteria1:="=*" & [F2] & "*", Operator:=xlAnd
End Sub
PS: On peut aussi faire les opérations de filtrage directement dans PowerQuery
 

job75

XLDnaute Barbatruc
Bonjour largo41270, JM,

Téléchargez le fichier .xlsm et dossiers zippés joints dans le même dossier (le bureau).

Exécutez cette macro affectée au bouton :
VB:
Sub Recherche()
Dim t, cible$, chemin$, fso As Object, ncol%, lig&, sf As Object, f As Object, nf%, wb As Workbook, plage As Range, i&, j%
t = Timer
cible = "*" & [B1].Text & "*"
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each sf In fso.Getfolder(chemin).Subfolders
    For Each f In sf.Files
        nf = nf + 1
        Set wb = Workbooks.Open(chemin & sf.Name & "\" & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = sf.Name
                    .Cells(lig, 2) = f.Name
                    .Cells(lig, 3).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f, sf
    .Offset(, 1).EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
Application.ScreenUpdating = True
MsgBox nf & " fichuers étudiés et " & lig - 2 & " ligne" & IIf(lig > 3, "s", "") & " copiée" & IIf(lig > 3, "s", "") & " en " & Format(Timer - t, "0.00 \sec")
End Sub
On notera que pour la recherche j'utilise la propriété .Text des cellules, cela prend plus de temps.

A+
 

Pièces jointes

  • test recherche.zip
    41.1 KB · Affichages: 9

largo41270

XLDnaute Nouveau
Bonjour a tous et merci de votre aide.
excusé moi d'avoir tardé a répondre
merci Job75 pour ton travail
effectivement il y a beaucoup de fichiers , comme je c'est a l'avance dans quel dossier ce trouve le fichier
j'ai donc besoin d'informer dans une cellule le chemin du fichier pour limiter l'ouverture de tout les dossiers
et une fois la recherche effectué un lien hyper.. sur le nom du fichier pour l'ouvrir

merci cousinhub pour ton fichier
il fonctionne bien effectivement il faudrait ouvrir tout le type de fichier XLS*
lundi je joindre un fichier type du boulot

merci encore a vous tous
 

largo41270

XLDnaute Nouveau
re bonjour a tous j'ai modifié le fichier de Cousinhub pour L'adapter

j'ai créé 2 macro 1 pour actualiser et l'autre pour créer les lien HyperText ,il fonctionnes bien individuellement
par contre quant je les affectes a un bouton les liens sont hs
je pense que ca vient du faite que la macro creerlien démarre avant que la recherche et fini

je sais pas comment résoudre ce problème
merci d'avance
 

Pièces jointes

  • test recherche.zip
    35.5 KB · Affichages: 7

job75

XLDnaute Barbatruc
Bonjour largo41270, le forum,

Si le dossier est déterminé il n'y aura qu'une vingtaine de fichiers à ouvrir.

Il est parfaitement inutile de créer des liens hypertextes.

Téléchargez les dossiers et fichiers zippés joints et exécutez ces macros :
VB:
Sub Dossier()
Dim chemin$, fso As Object, sf As Object, liste$
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.Getfolder(chemin).Subfolders
    liste = liste & "," & sf.Name
Next sf
With [B1]
    .Validation.Delete
    .Validation.Add xlValidateList, Formula1:=Mid(liste, 2)
    .Select
    CreateObject("WScript.Shell").SendKeys "%{DOWN}"
End With
End Sub

Sub Recherche()
Dim sf$, cible$, chemin$, fso As Object, ncol%, lig&, f As Object, wb As Workbook, plage As Range, i&, j%
sf = [B1]
If sf = "" Then Dossier: Exit Sub
cible = "*" & [D1].Text & "*"
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each f In fso.Getfolder(chemin & sf).Files
        Set wb = Workbooks.Open(chemin & sf & "\" & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = f.Name
                    .Cells(lig, 2).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f
    .Offset(, 1).EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub
La macro Dossier crée la liste permettant de choisir le dossier.

A+
 

Pièces jointes

  • test recherche.zip
    38.2 KB · Affichages: 3

job75

XLDnaute Barbatruc
Une autre manière est de choisir le dossier avec Application.FileDialog :
VB:
Sub Recherche()
Dim cible$, fso As Object, ncol%, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, i&, j%
cible = "*" & [F1].Text & "*"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 5 'nombre de colonnes à étudier
ChDir ThisWorkbook.Path 'dossier initial
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then [B1] = "": Exit Sub
sf = dossier.SelectedItems(1) & "\"
[B1] = sf
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each f In fso.Getfolder(sf).Files
        Set wb = Workbooks.Open(sf & f.Name) 'ouverture du fichier
        Set plage = wb.Sheets(1).Range("B3").CurrentRegion.Resize(, ncol) 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                If plage(i, j).Text Like cible Then
                    .Cells(lig, 1) = f.Name
                    .Cells(lig, 2).Resize(, ncol) = plage.Rows(i).Value
                    lig = lig + 1
                    Exit For
                End If
        Next j, i
        wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    If .Columns(5).ColumnWidth < 13 Then .Columns(5).ColumnWidth = 13
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub
 

Pièces jointes

  • test recherche.zip
    37.4 KB · Affichages: 5

largo41270

XLDnaute Nouveau
bonjour wtf merci de ta réponse.

il y a minimun 20 fichiers par dossiers et environ 30 dossiers

j'ai trouvé un fichier qui pourrait faire le travail , je n'arrive pas a le modifier , je suis trop nul

le fichier liste tous les dossiers dans la colonne a ( pas besoins)
et affiche le résultat dans une box avec le chemin du dossier, moi je voudrais que la ligne complète s'affiche sur ma feuille et en cliquant sur cette ligne ca ouvre le fichier.

en Piece jointe fichier et dossiers j'ai mis le code d'origine (des que je modifies un truc ca bug pufffffff

merci d'avance
oups j'ai pas joint le bon fichier
 

Pièces jointes

  • test recherche2.zip
    56.3 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour le forum, Cousinhub,

Si l'on tient à créer les liens hypertextes il suffit dans mon dernier fichier de remplacer :
VB:
.Cells(lig, 1) = f.Name
par :
VB:
.Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
A+
 

Pièces jointes

  • test recherche.zip
    37.8 KB · Affichages: 5

Discussions similaires

Réponses
6
Affichages
375

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 489
Messages
2 088 855
Membres
103 976
dernier inscrit
kaizertv2001@gmailcom