Microsoft 365 Effectué une recherche dans plusieurs fichiers

[largo41270]

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

 

[job75]

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 :

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+

 

[job75]

Une autre manière est de choisir le dossier avec Application.FileDialog :

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

 

[largo41270]

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

 

[Cousinhub]

Bonjour,
Dans le fichier joint, j'ai modifié la requête pour prendre en compte tous les fichiers ".xls*"
La requête est également modifié afin de rajouter une formule "=Lien.Hypertexte......" qui est transformée en véritable lien lors de la mise à jour.
Cette transformation s'opère dès que la requête est terminée (voir le code dans le module "actualiser", et dans l'évènement de feuille de la Feuil1)
Bonne journée

 

[job75]

Bonjour le forum, Cousinhub,

Si l'on tient à créer les liens hypertextes il suffit dans mon dernier fichier de remplacer :

.Cells(lig, 1) = f.Name

par :

.Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte

A+