Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz · 14 Mars 2022

Bonjour à toutes et à tous

En voici une bonne pour ce début de semaine lol

Evidemment, je ne sais pas coder pour résoudre mon besoin !
Alors, je sollicite à nouveau nos chers ténors :

Voici le contexte de mon besoin :
NOUS TRAVAILLONS AVEC 3 FICHIERS ouverts généralement en même temps.

Les Professionnels que nous appelons sont difficiles à joindre.
Nous avons souvent des répondeurs et nous laissons un message.

Quand un Pro nous rappelle, NOUS DE DECROCHONS PAS.
Avant de rappeler nous vérifions à partir de quel fichier on a appelé pour savoir où nous en sommes avec le Pro.

Pour le rappeler il faut faire vite avant que le Pro ne soit à nouveau occupé.
Pour cela, il nous faut trouver très rapidement à partir de quel fichier nous avons appelé.

Nos 3 fichiers sont identiques et nous commençons toujours nos recherches par la feuille Appels,
Le besoin
Partant du principe que nos 3 fichiers sont généralement ouverts en même temps (mais ce n'est pas toujours le cas) :
Est-il possible si la recherche ne trouve rien dans la feuille active (Appels) du fichier actif que la recherche :
si pas trouvé que la recherche propose de chercher dans le fichier suivant (ouvert) ? :

Les noms des fichiers sont toujours les mêmes sauf la date qui change.
isiTel_lionel_fichier1 2022 03 14
isiTel_lionel_fichier2 2022 03 14
isiTel_lionel_fichier3 2022 03 14

Auriez-vous le bon code ?

Un grand merci par avance

Je continue à tâtonner .. et je joins un petit fichier test qui contient le code de la recherche.
Amicalement,
lionel

Usine à gaz · 22 Mars 2022

Ha Gérard, toujours au pointilleux et j'apprécie

Merci Gérard, ça marche nickel,
lionel

Usine à gaz · 22 Mars 2022

Re à toutes et à tous,

Tout fonctionne à merveille ... du tonnerre

Super Gérard, je ne sais comment dire MERCI ... du GRAND art !

Mon cher Gérard va s'ennuyer sans moi lol
mais ne soyons pas tristes, j'en ai en réserve des "toufous"

lionel

ChTi160 · 22 Mars 2022

Bonjour Lionel, Le Fil, Le Forum
@Gérard
Ne pourrait-il pas y avoir traitement des erreurs provoquées par l'absence du fichier que l'on recherche (mais dont le Nom est présent dans la liste des Fichiers Sources (Colonne 4))
Par exemple en mettant la gestion avant et ainsi éliminer 3 des erreurs provoquées par absence du fichier.
voir ce à quoi je pense.

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, lig&, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next ' il faut apostropher pour test messages d'erreur.
Set wb = Workbooks(CStr(Cells(lig, 4))) 'Bon , seulement si le Fichier ouvert
If wb Is Nothing Then Set wb = Workbooks.Open(chemin & Cells(lig, 4)) 'si Non Ouvert on tente de l'ouvrir
'ci-dessous si pas trouvé le Fichier (wb) alors que la cellule source n'est pas vide et que l'on est sur une Ligne >1
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48: Exit Sub 'On quitte après avoir affiché un message
Application.EnableEvents = False
 MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear
With wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
 MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear
    Application.Goto .Cells(1, 2 - .Column), True 'cadrage
 MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear
    .RowHeight = 55
 MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear
End With
'If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable!", 48
Application.EnableEvents = True
End Sub

Voir en remettant la gestion en service en Bas de la procédure et en apostrophant la Ligne que j'ai rajouté. avec le Exit Sub
Pour le test j'ai modifié le Nom d'un des fichiers présents pour le rendre inexistant (car je n'ai pas su reproduire le Fait qu'un nom de fichier est présent en Colonne 4 mais qu'il n'existe pas ???)
Si ce n'est de le supprimer entre temps ! Lol
Bonne fin de Journée
Jean marie

Usine à gaz · 22 Mars 2022

ChTi160 à dit:
Bonjour Lionel, Le Fil, Le Forum
@Gérard
Ne pourrait-il pas y avoir traitement des erreurs provoquées par l'absence du fichier que l'on recherche (mais dont le Nom est présent dans la liste des Fichier Source (Colonne 4))
Par exemple en mettant la gestion avant et ainsi éliminer 3 des erreurs provoquées par absence du fichier.
voir ce à quoi je pense

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim chemin$, lig&, wb As Workbook chemin = ThisWorkbook.Path & "\" 'à adapter lig = Target.Row On Error Resume Next Set wb = Workbooks(CStr(Cells(lig, 4))) 'Bon , seulement si le Fichier ouvert If wb Is Nothing Then Set wb = Workbooks.Open(chemin & Cells(lig, 4)) 'si Non Ouvert on tente de l'ouvrir 'ci-dessous si pas trouvé le Fichier (wb) alors que la cellule source n'est pas vide et que l'on est sur une Ligne >1 If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48: Exit Sub 'On quitte après avoir affiché un message Application.EnableEvents = False MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear With wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6)) MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear Application.Goto .Cells(1, 2 - .Column), True 'cadrage MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear .RowHeight = 55 MsgBox Err.Number & vbCrLf & Err.Description: Err.Clear End With 'If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable!", 48 Application.EnableEvents = True End Sub

Voir en remettant la gestion en service en Bas de la procédure et en apostrophant la Ligne que j'ai rajouté. avec le Exit Sub
Pour le test j'ai modifié le Nom d'un des fichiers présents pour le rendre inexistant (car je n'ai pas su reproduire le Fait qu'un nom de fichier est présent en Colonne 4 mais qu'il n'existe pas ???)
Si ce n'est de le supprimer entre temps ! Lol
Bonne fin de Journée
Jean marie

Bonjour Jean-Marie,
Merci pour ta perspicacité et pour ton code

Je teste ce soir,
lionel

Usine à gaz · 23 Mars 2022

Bonjour Jean-Marie, Gérard, le Forum,

JM : j'ai testé hier et ça fonctionne aussi

Merci à toi,
lionel

ChTi160 · 23 Mars 2022

Bonjour Lionel
Bonjour le Fil
Merci de ce retour !
J'ai pensé pourquoi laisser des erreurs se produire (mais traitées par le On error resume Next )
Plutôt que de quitter dès la gestion de la première !
Bonne fin de Journée
jean marie

Usine à gaz · 24 Mars 2022

Bonsoir Gérard, Bonsoir Jean-Marie, Bonsoir Phil, le Forum,

@ Gérard,
Pour information, après presque une semaine d'utilisation.
Le code fonctionne du tonnerre, c'est génial,
Merci Gérard et à vous tous qui avez participé à ce fil.
lionel

Usine à gaz · 13 Août 2022

Bonsoir à tous les participants du fil, à toutes et à tous

J'aurais besoin d'une amélioration et je reviens sur le fil.
J'avais retenu la solution du #post 125 de Gérard qui fonctionne toujours super bien

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille$, plage As Range, lig&, col As Range, x$, n&
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = "Appels"
Set plage = [D1:G10000] 'référence de la plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""
    x = chemin & "[" & fichier & "]" & feuille & "'!"
    For Each col In plage.Columns
        n = 0
        Do 'boucle pour rechercher toutes les occurrences
            Cells(lig, 6).FormulaArray = "=MATCH(""*" & cible & """,""""&'" & x & col.Offset(n).Address & ",0)" 'formule matricielle
            If IsError(Cells(lig, 6)) Then Exit Do
            n = n + Cells(lig, 6)
            Cells(lig, 4) = fichier
            Cells(lig, 5) = feuille
            Cells(lig, 7) = "=INDEX('" & x & col.Address & "," & n & ")"
            Cells(lig, 7) = Cells(lig, 7).Value 'supprime la formule
            Cells(lig, 7).NumberFormat = "General" 'format Standard
            Cells(lig, 6) = Split(col.Address, "$")(1) & n 'adresse qui écrase la formule
            lig = lig + 1
        Loop
    Next col
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":G" & Rows.Count).ClearContents 'RAZ
Application.EnableEvents = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim chemin$, lig&, wb As Workbook
chemin = ThisWorkbook.Path & "\" 'à adapter
lig = Target.Row
On Error Resume Next
Set wb = Workbooks(CStr(Cells(lig, 4)))
If wb Is Nothing Then Set wb = Workbooks.Open(chemin & Cells(lig, 4))
Application.EnableEvents = False
With wb.Sheets(CStr(Cells(lig, 5))).Range(Cells(lig, 6))
    Application.Goto .Cells(1, 2 - .Column), True 'cadrage
    .RowHeight = 55
End With
Application.EnableEvents = True
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub

Le code recherche dans la feuille = "Appels" des classeurs.
J'ai un autre Classeur et peut-être d'autres à ajouter et les feuilles auront des noms différents de "Appels" :
Je connais les noms, par exemple :
- feuille = "Bidule"
- feuille = "Machin"
etc...

Est-il possible de rechercher pour chaque classeur, dans les feuilles si elles existes ? :
- feuille = "Appels"
- feuille = "Bidule"
- feuille = "Machin" et d'autres si besoin
Si cela est possible, je pense que le temps d'exécution va être beaucoup plus long ?
pour info, le classeur qui contient les feuilles "Sextant", "Dr House" etc..
Est nommé : isiTel_zRappels RdVs annulés

lol, je continue à bidouiller ....

Merci d'avance,
lionel

job75 · 14 Août 2022

Bonjour Lionel, le forum,

Je disais que ce fil était sans fin !!!

Pour traiter plusieurs feuilles il suffit d'ajouter une boucle sur les noms des feuilles :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim cible$, chemin$, fichier, feuille, plage As Range, lig&, i%, col As Range, x$, n&
cible = Right([B1], 9) 'à adapter
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "isiTel*.xlsb") '1er fichier du dossier
feuille = Array("Appels", "Sextant", "Dr House") 'liste des feuilles où l'on recherche
Set plage = [D1:G10000] 'référence de la plage de recherche à adapter
lig = 2
Application.ScreenUpdating = False
Application.EnableEvents = False
While fichier <> ""
    For i = 0 To UBound(feuille)
        x = "'" & chemin & "[" & fichier & "]" & feuille(i) & "'!"
        If Not IsError(ExecuteExcel4Macro(x & "R1C1")) Then 'vérifie que la feuille existe
            For Each col In plage.Columns
                n = 0
                Do 'boucle pour rechercher toutes les occurrences
                    Cells(lig, 6).FormulaArray = "=MATCH(""*" & cible & """,""""&" & x & col.Offset(n).Address & ",0)" 'formule matricielle
                    If IsError(Cells(lig, 6)) Then Exit Do
                    n = n + Cells(lig, 6)
                    Cells(lig, 4) = fichier
                    Cells(lig, 5) = feuille(i)
                    Cells(lig, 7) = "=INDEX(" & x & col.Address & "," & n & ")"
                    Cells(lig, 7) = Cells(lig, 7).Value 'supprime la formule
                    Cells(lig, 7).NumberFormat = "General" 'format Standard
                    Cells(lig, 6) = Split(col.Address, "$")(1) & n 'adresse qui écrase la formule
                    lig = lig + 1
                Loop
            Next col
        End If
    Next i
    fichier = Dir 'fichier suivant
Wend
Range("D" & lig & ":G" & Rows.Count).ClearContents 'RAZ
Application.EnableEvents = True
End Sub

Comme on le voit j'ai ajouté un test pour vérifier que la feuille existe.

A+

Usine à gaz · 14 Août 2022

Bonjour Gérard

, le Forum,
Bonne journée à toutes et à tous

Merci pour ton code qui va m'être très utile pour mon nouveau besoin.
Il est vrai que j'aurais du créer un autre fil plutôt que t'utiliser celui-ci.
Cela aurait évité "Je disais que ce fil était sans fin !!!"
Tu me l'avais déjà dit : nouvelle demande = nouveau fil et tu avais raison.

Je teste et je te dis.
lionel

Usine à gaz · 14 Août 2022

Re-Gérard

Juste super nickel comme d'habitude

Vraiment utile pour moi.
Je te remercie,
lionel

Usine à gaz · 14 Août 2022

Et semble aussi rapide que le précédent code (je ne vois pas la différence)

super de chez super !

job75 · 14 Août 2022

La durée d'exécution dépend bien sûr du nombre de feuilles à traiter.

Usine à gaz · 14 Août 2022

Je le pensais bien et aussi de la taille des feuilles.
Mais cela semble minime

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums