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

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 <> ""...

juvaxe · 21 Mars 2022

Bonjour

J'arrive sans doute un peu tard dans cette discussion.

La complexité du problème est due à la répartition des données dans plusieurs classeurs.

Non pas de faire "une usine à gaz" (désolé du jeu de mots !) je pense qu'il était préférable et plus simple d'héberger les données dans un même endroit , par exemple SQL Server, sur un poste de travail défini comme serveur.

Sur les autres postes de travail se servir de Excel/vba (pas de problème) pour accéder à la base de données et faire le travail quotidien.

Installer une base de données et l'utiliser n'est pas plus difficile que faire du VBA. Il y a de nombreux exemples sur le Net et en particulier dans ce forum.

Bien cordialement

Usine à gaz · 21 Mars 2022

juvaxe à dit:
Bonjour

J'arrive sans doute un peu tard dans cette discussion.

La complexité du problème est due à la répartition des données dans plusieurs classeurs.

Non pas de faire "une usine à gaz" (désolé du jeu de mots !) je pense qu'il était préférable et plus simple d'héberger les données dans un même endroit , par exemple SQL Server, sur un poste de travail défini comme serveur.

Sur les autres postes de travail se servir de Excel/vba (pas de problème) pour accéder à la base de données et faire le travail quotidien.

Installer une base de données et l'utiliser n'est pas plus difficile que faire du VBA. Il y a de nombreux exemples sur le Net et en particulier dans ce forum.

Bien cordialement

Bjr Juvaxe
Merci pour vos suggestions mais dans notre procès la méthode utilisée est celle qui convient à notre façon de travailler et le code de Job75 est génialement efficace

Usine à gaz · 21 Mars 2022

Re-Gérard,

J'ai utilisé le fichier depuis ce matin ..... c'est un bijou,
Gràce à ton code, je rappelle sous qq secondes et je joins quasi toujours celui qui m'a appelé.
Fonctionne du tonnerre, c'est nickel

Usine à gaz · 21 Mars 2022

Re-Gérard,

Je travaille depuis ce matin avec ton fichier ...
Génialissime ... extra et j'en passe
Tu vas m'arracher les yeux quand je te montrerai ce que j'ai fait lol.
Tant pis, je prendrais le risque de l'infirmité lol
Merci Gérard,
lionel

job75 · 21 Mars 2022

Bonjout Lionel, le fil,

Bon maintenant c'est moi qui vais faire durer le plaisir

Avec cette solution qui recherche toutes les occurrences dans chaque colonne :

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

Bien sûr toujours sans ouvrir les fichiers fermés.

Tu n'en as peut-être pas besoin mais c'est au cas où...

A+

Usine à gaz · 21 Mars 2022

Bonsoir Gérard,

J'aime, tu continues tant que tu veux
Je teste un peu plus tard et je reviens te dire,

Génial ...
lionel

Usine à gaz · 21 Mars 2022

Re-Gérard,

J'ai testé et évidemment, c'est nickel
Nul je suis, il me semble que c'est bien plus rapide mais ... lol
lionel

Usine à gaz · 21 Mars 2022

Mais je n'arrive pas à faire fonctionner le double clic sur une cellule en col F

job75 · 21 Mars 2022

C'est forcément moins rapide s'il y a plusieurs occurrences dans chaque colonne.

Pour le double-clic utilises-tu bien la macro du post #125 ? Il fonctionne sur toute cellule.

Usine à gaz · 21 Mars 2022

"C'est forcément moins rapide s'il y a plusieurs occurrences dans chaque colonne."
LOL c'est pas visible à l'oeil ... ça me semblait plus rapide.
J'ai bien vu qu'il prenait toutes les occurrences et c'est super ça

"Pour le double-clic utilises-tu bien la macro du post #125 ?"
Oui, j'ai pris le fichier tel quel et chez moi ça ne fonctionne que sur quelques cellules et pas toujours.

Usine à gaz · 21 Mars 2022

Bonsoir Gérard,
En modifiant le code comme ceci :

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)))
'If wb Is Nothing Then EN NEUTRALISANT CETTE LIGNE
    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
'End If ET LE END IF
If wb Is Nothing And Cells(lig, 4) <> "" And lig > 1 Then Cancel = True: MsgBox "Fichier '" & Cells(lig, 4) & "' introuvable !", 48
End Sub

C'est fonctionnel en neutralisant : If wb Is Nothing Then

Usine à gaz · 22 Mars 2022

Je suis désolé, je ne tiens plus debout lol et je dois me lever à 6 h tout à l'heure.
Il n'y a pas urgence. J'ai déjà un fichier qui fonctionne nickel.
Bonne nuit Gérard, le Forum ...
A tout à l'heure,
lionel

job75 · 22 Mars 2022

Il y avait une erreur grossière dans la 2ème macro de mon post #125, je viens de la corriger.

Bonne nuit.

Usine à gaz · 22 Mars 2022

Bonjour Gérard, le Forum,

OK, je prends.
Test Nickel encore merci pour cette version.
Bonne journée

job75 · 22 Mars 2022

Bonjour Lionel, le forum,

Bon un détail, au post #125 je viens de déplacer :

VB:

x = chemin & "[" & fichier & "]" & feuille & "'!"

avant la boucle For Each col, c'est plus propre.

A+

Microsoft 365 Rechercher dans plusieurs fichiers

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

juvaxe

XLDnaute Occasionnel

Usine à gaz

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

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires