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

 

[largo41270]

super boulot tous les deux merci
j'ai oublié de prendre des fichiers du boulot le les prends demain (j'ai remarqué quelque truc sur les fichiers source du boulot qui je pence vont pauser problèmes on verras demain avec les fichiers)
je prends vos de dernier fichiers pour tester au boulot

bonne soirée a vous

 

[largo41270]

salut a tous,
comme convenue voila 3 fichiers source.
vos 2 code fonctionne mais pas sur tous les fichiers ,c'est normale puisque tous les fichiers source
ne sont pas montés pareil entête colonne différente, et les infos nécessaires ne sont pas toujours dans la même colonne ( c'est fichiers me sont envoyés par les fournisseurs)
merci a vous

 

[largo41270]

bonjour job75,
je viens de faire quelque test su ton fichier et modifier le nombre de colonne a traité et ca fonctionne
par contre les entêtes ne corresponde pas est ce qu'il est possible importer les entêtes du fichier source en même temps que le résultat de la recherche( puisque les résultats seront obligatoirement dans le même fichier)
merci d'avance

 

[job75]

Bonjour largo41270,

Avec cette solution la recherche se fait uniquement sur les textes commençant par la lette "K", normalement cela ne concerne que 2 colonnes (S/N et Pallet No) :

Sub Recherche()
Dim cible$, fso As Object, ncol%, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, i&, j%, x$
cible = "*" & [F1].Text & "*"
Set fso = CreateObject("Scripting.FileSystemObject")
ncol = 10 '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).UsedRange 'adapter éventuellement
        For i = 2 To plage.Rows.Count
            For j = 1 To ncol
                x = plage(i, j)
                If x Like "K*" Then
                    If x Like cible Then
                        If .Cells(lig, 1) = "" Then .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
                        If Right(x, 1) Like "#" Then .Cells(lig, 2) = x
                    If Right(x, 1) = "F" Then .Cells(lig, 3) = x
                    End If
                End If
            Next j
            If .Cells(lig, 1) <> "" Then .Cells(lig, 4) = i + plage.Row - 1: lig = lig + 1
        Next i
        wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

Les valeurs trouvées sont restituées avec le numéro de ligne.

A+

 

[job75]

J'ai ajouté cette macro dans le code de la feuille :

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Application.Goto ActiveWorkbook.Sheets(1).Range("A" & Target.Parent(1, 4)), True
End Sub

Elle cadre la feuille quand on clique sur un lien hypertexte.

 

[largo41270]

merci
par contre certaine des références dans d'autre fichiers ne commence pas par K

 

[alexga78]

Bonsoir à tous,

En repartant du fichier de @Cousinhub un essai par PQ - import de toutes les colonnes et filtre sur le mot recherché (dans toutes les colonnes) si j'ai bien compris la demande...

Bonne soirée

 

[job75]

Bonjour largo41270, le forum,

par contre certaine des références dans d'autre fichiers ne commence pas par K

Bah vous allez bien trouver une manière de distinguer les colonnes à traiter.

Par exemple leur couleur :

Sub Recherche()
Dim cible$, fso As Object, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, ncol%, coul As Boolean, i&, col%, j%
cible = "*" & [F1].Text & "*"
Set fso = CreateObject("Scripting.FileSystemObject")
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).UsedRange 'adapter éventuellement
        ncol = plage.Columns.Count
        coul = False
        For i = 2 To plage.Rows.Count
            col = 2
            For j = 1 To ncol
                If plage(i, j).Interior.ColorIndex = 6 Then 'couleur jaune
                    coul = True
                    If plage(i, j).Text Like cible Then
                        If .Cells(lig, 1) = "" Then .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
                        .Cells(lig, col) = plage(i, j)
                    End If
                    col = 3
                End If
            Next j
            If .Cells(lig, 1) <> "" Then .Cells(lig, 4) = i + plage.Row - 1: lig = lig + 1
        Next i
        If Not coul Then MsgBox "Couleur jaune non trouvée sur " & f.Name
        wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

A+

 

[largo41270]

Bonjour job 75
effectivement il vas falloir que je différencie les colonnes
plusieurs solutions s'offre a moi , mais je sais pas si c'est possible avec ton code
1) le plus facile pour moi et de renommer les entêtes pour que les 2 colonnes ou effectuer la recherche soit identique
2) par couleur ,la couleur jaune que long vois dans les fichiers c'est quand cette réf a était attribuer a un client,
ma question est la recherche par couleur s'effectue seulement sur les cellules jaune ou sur toute la colonne qui comporte une cellule jaune, dans ce cas la je pourrais insérer une ligne sous les entêtes et mettre une couleur sur la cellule

merci d'avance
et encore merci pour ton travail

 

[job75]

Bonjour largo41270, le forum,

Ma macro du post #23 traite les cellules colorées en jaune uniquement.

Mais il vaut beaucoup mieux repérer les 2 colonnes par les 2 en-têtes "S/N" et "Pallet No." :

Sub Recherche()
Dim cible$, entete, fso As Object, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, col, j%, c As Range, i&
cible = "*" & [F1].Text & "*"
entete = Array("S/N", "Pallet No.") 'les 2 colonnes à étudier
Set fso = CreateObject("Scripting.FileSystemObject")
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 = ActiveSheet.Range("A1", ActiveSheet.UsedRange)
        ReDim col(1)
        For j = 0 To 1
            Set c = plage.Find(entete(j), , xlValues, xlWhole)
            If c Is Nothing Then MsgBox "En-tête non trouvée dans " & wb.Name: GoTo 1
            col(j) = c.Column
        Next j
        For i = c.Row + 1 To plage.Rows.Count
            For j = 0 To 1
                If plage(i, col(j)) <> "" Then
                    If plage(i, col(j)).Text Like cible Then
                        If .Cells(lig, 1) = "" Then .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
                        .Cells(lig, j + 2) = plage(i, col(j))
                    End If
                End If
            Next j
            If .Cells(lig, 1) <> "" Then .Cells(lig, 4) = i : lig = lig + 1
        Next i
1       wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

A+

 

[largo41270]

je te remercie
effectivement
je vais cette semaine travailler sur la modification des fichiers
je te tien au courant
encore merci pour ton boulot ca vas me faire gagner beaucoup de temps

 

[largo41270]

je viens de faire des testes sur les trois fichiers que j'ai en ma possession
ca fonction bien c'est top
es ce qu'il est possible que l'on face les recherches dans les 2 colonnes comme actuellement et que l'on importe également la dernière colonne avec entête AFFAIRE/CLIENT
merci d'avance

 

[job75]

Au post #25 j'ai modifié :

Set plage = ActiveSheet.Range("A1", ActiveSheet.UsedRange)

 

[job75]

es ce qu'il est possible que l'on face les recherches dans les 2 colonnes comme actuellement et que l'on importe également la dernière colonne avec entête AFFAIRE/CLIENT

Tout à fait, juste une recherche d'en-tête supplémentaire :

Sub Recherche()
Dim cible$, entete, fso As Object, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, col, j%, c As Range, cc As Range, dercol%, i&
cible = "*" & [G1].Text & "*"
entete = Array("S/N", "Pallet No.") 'les 2 colonnes à étudier
Set fso = CreateObject("Scripting.FileSystemObject")
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 = ActiveSheet.Range("A1", ActiveSheet.UsedRange)
        ReDim col(1)
        For j = 0 To 1
            Set c = plage.Find(entete(j), , xlValues, xlWhole)
            If c Is Nothing Then MsgBox "En-tête non trouvée dans " & wb.Name: GoTo 1
            col(j) = c.Column
        Next j
        Set cc = plage.Find("AFFAIRE/CLIENT")
        If cc Is Nothing Then dercol = 0 Else dercol = cc.Column
        For i = c.Row + 1 To plage.Rows.Count
            For j = 0 To 1
                If plage(i, col(j)) <> "" Then
                    If plage(i, col(j)).Text Like cible Then
                        If .Cells(lig, 1) = "" Then .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
                        .Cells(lig, j + 2) = plage(i, col(j))
                    End If
                End If
            Next j
            If .Cells(lig, 1) <> "" Then
                If dercol Then .Cells(lig, 4) = plage(i, dercol)
                .Cells(lig, 5) = i
                lig = lig + 1
            End If
        Next i
1       wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

 

[largo41270]

cool trop top
es ce qu'il et possible également de prendre la mise en forme des cellules
puisque dans les fichiers quand s/n est attribué a un client les cellules sont en jaune

et sans abuser est il possible une fois avoir fait une recherche et que j'attribut la recherche a un client (donc je passe la cellule s/n et pallet no. en jaune et rentre le nom de l' affaire en affaire/client j'ai un bouton (enregistrer) pour aller modifier le fichier en question

je suis trop contant ca vas vraiment me faire gagner un temps fous
merci encore