XL 2016 Lire dans classeurs fermés et copie si trouve

[Usine à gaz]

Bonjour à toutes et à tous,

Me voici devant un nouveau souci de codification que je ne sais vraiment pas faire.
Malgré mes recherches j'ai pas trouvé de solution sur le site et sur le net.
J'ai tenté beaucoup de codes que j'ai tenté d'adapter sans succès.

Je ne tourne "naturellement" LOL vers nos ténors toujours si efficaces pour solliciter de l'aide.

Voici mon problème :
ici, pour l'exemple, j'ai créé 3 classeurs (si solution il y a, il me sera facile de modifier pour inclure tous les classeurs dans le code)

Je souhaiterai qu'à partir du fichier "Import_Valeur_Cherchée" onglet "Résultat" :

1 - je clique sur le bouton "recherche",
2 - je colle le N° qui appelle,
3 - le code va lire tous les classeurs (fermés) et s'il trouve, il me copie la ligne (où les lignes si plusieurs) dans ce classeur dans l'onglet "Résultat"

Pour tests codes, je joins les classeurs :
Import_Valeur_Cherchée (qui contient dans l'onglet "Ce que je voudrais faire", l'explication détaillée de mon besoin)
Classeur_1 - Classeur_2 - Classeur_3
+ classeur qui contient d’excellents codes de SilkyRoad qui me semblent proches de mon besoin.

En espérant que vous pourrez, une nouvelle fois m'aider et vous en remerciant,
Je vous souhaite à toutes et à tous une très belle journée.
Amicalement,
Lionel,

 

[job75]

Bonjour Lionel,

S'il n'y a pas trop de fichiers il est bien plus simple de les ouvrir, de les traiter et de les refermer :

Sub Recherche()
Dim tel$, chemin$, fichier$, resu(), tablo, i&, n&, j%
tel = InputBox("Entrez le numéro de téléphone recherché :")
If tel = "" Then Exit Sub
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*")
ReDim resu(1 To Rows.Count, 1 To 27)
Application.ScreenUpdating = False
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier).Sheets("Donnees")
            tablo = Intersect(.UsedRange.EntireRow, .[I:AI]) 'matrice, plus rapide
                For i = 1 To UBound(tablo)
                    If CStr(tablo(i, 6)) = tel Or CStr(tablo(i, 7)) = tel Then
                        n = n + 1
                        For j = 1 To 27
                            resu(n, j) = tablo(i, j)
                        Next j
                    End If
                Next i
            .Parent.Close False
        End With
    End If
    fichier = Dir
Wend
'---restitution---
With [I2] 'cellule à adapter
    If n Then .Resize(n, 27) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 27).ClearContents 'RAZ en dessous
End With
End Sub

A+

 

[Usine à gaz]

Bonjour Gérard,,

Content de te revoir
Merci pour ton code.

"S'il n'y a pas trop de fichiers il est bien plus simple de les ouvrir, de les traiter et de les refermer :"

C'est ce que je fais depuis le début mais les fichiers sont lourds et quand un prospect appelle, il faut agir vite?

C'est pour cela que ce serait génial que ça puisse fonctionner.
Je teste et je reviens
Lionel,

 

[Usine à gaz]

Re-Gérard,

Magique !!! ça fonctionne avec les fichiers test et c'est rapide.
Un super merci, c'est génial
Je teste demain avec les fichiers de travail et je te dirai
Bonne fin de journée.
Lionel,

 

[zebanx]

Bonjour arthour973, Job75

Par rapport à la structure des fichers (tableau double entrée, structuration identique, besoin de nombreux enregistrements), ne serait-il pas envisageable de tout passer sur "access" plutôt qu'excel ?

Bonne journée à tous les deux

 

[Usine à gaz]

Bonjour Zebanx,
Merci d'être là
Je ne connais du tout "access"
Il y a longtemps que j'ai prévu de l'étudier mais je suis occupé que je n'ai pas encore plus prendre le temps

 

[zebanx]

Re

Le temps toujours.
C'est sûr que c'est mieux de sonder un peu dans l'entourage si quelqu'un connait access pour montrer l'utilité.
Ou de s'auto-fermer. Il faut en avoir le temps et la motivation.
En attendant, JOB75... permettent "de" donc... ça va

Bonne journée
zebanx

 

[job75]

Re, salut zebanx,

mais les fichiers sont lourds et quand un prospect appelle, il faut agir vite?

Avec les 3 fichiers sources de 19 lignes l'exécution se fait chez moi en 1,8 seconde.

Avec 3 fichiers sources de 18 000 lignes (1,6 Mo) l'exécution se fait en 5 secondes.

 

[Usine à gaz]

Merci Gérard, pour ce test,
Je fais mes tests avec les fichiers de travail demain matin
Lionel,

 

[job75]

Bonjour Lionel, le forum,

Pour gagner du temps on peut ouvrir les fichiers et ne plus les fermer :

Public Ouvre As Boolean 'mémorise la variable

Sub Recherche()
Dim tel$, chemin$, fichier$, resu(), F As Worksheet, tablo, i&, n&, j%
If Ouvre Then tel = Chr(1) Else tel = InputBox("Entrez le numéro de téléphone recherché :")
If tel = "" Then Exit Sub
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*")
ReDim resu(1 To Rows.Count, 1 To 27)
Application.ScreenUpdating = False
On Error Resume Next
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        Set F = Nothing: Set F = Workbooks(fichier).Sheets("Donnees")
        If F Is Nothing Then Set F = Workbooks.Open(chemin & fichier).Sheets("Donnees"): ActiveWindow.WindowState = xlMinimized
        tablo = Intersect(F.UsedRange.EntireRow, F.[I:AI]) 'matrice, plus rapide
        For i = 1 To UBound(tablo)
            If CStr(tablo(i, 6)) = tel Or CStr(tablo(i, 7)) = tel Then
                n = n + 1
                For j = 1 To 27
                    resu(n, j) = tablo(i, j)
                Next j
            End If
        Next i
    End If
    fichier = Dir
Wend
'---restitution---
With Feuil1.[I2] 'cellule à adapter
    If n Then .Resize(n, 27) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 27).ClearContents 'RAZ en dessous
    .Parent.Parent.Activate
End With
End Sub

Ouvertures et fermetures des fichiers par ces codes dans ThisWorkbook :

Private Sub Workbook_Open()
Ouvre = True: Recherche: Ouvre = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim w As Workbook
For Each w In Workbooks
    If w.Name <> Me.Name Then w.Close True
Next
Me.Save
Application.Quit
End Sub

J'ai testé avec 3 fichiers sources de 18 000 lignes : l'exécution se fait en 0,8 seconde.

A+

 

[Usine à gaz]

Bonjour Gérard, le forum,

Encore merci Gérard pour ton "justaboutisme"
Justement, je suis en train de tester.
Je regarde aussi ton nouveau code,
Lionel

 

[job75]

Je viens de légèrement modifier la dernière macro Recherche.

 

[Usine à gaz]

Re-Bonjour Gérard, le forum,

J'ai testé LOL

Le second code chez moi (post 10) est plus long a exécuter.
Cela doit provenir du temps à ouvrir les fichiers qui ne contiennent pas 180.000 lignes mais beaucoup de colonnes avec formules et longs à ouvrir.

Ne m'en veut pas mais je préfère le 1er code car il n'affiche que le fichier "Import_Valeur_Cherchée" et plus rapide chez moi.

Résultats de mes tests :
Temps pour trouver la ligne contenant le N° à chercher, comme je faisais avant en ouvrant les fichiers et en recherchant dans chaque fichier :
entre 1 et 2 minutes

Temps avec le fichier "Import_Valeur_Cherchée" qui contient ton code post2 :
entre 35 et moins d'une minute
Ton code fonctionne nickel et c'est déjà un gain de temps important qui me permet de savoir rapidement de quoi je vais parler avec mon interlocuteur.

Toutefois, j'aurai besoin d'un temps de réaction encore plus rapide LOL

Je pense que c'est du à l'ouverture et fermeture des fichiers
Le temps à ouvrir les fichiers est long (ils ne contiennent pas 180.000 lignes mais beaucoup de colonnes avec formules).

Serait-il possible d'exécuter le code sans ouvrir les fichiers ?
Cela devrait encore réduite le temps d'exécution.

Mais si pas possible ou si trop de temps à passer pour toi, je resterai sur ton code (post2)
qui déjà m'apporte beaucoup et qui fonctionne super bien

Un grand merci Gérard
Lionel,

 

[Usine à gaz]

Oups, j'ai posté avant ton dernier message
Je regarde

 

[job75]

Le code post #10 ouvre les fichiers sources uniquement à l'ouverture du fichier Import_Valeur_Cherchée(1).xlsm.

Ensuite quand on clique sur le bouton pour faire une recherche l'exécution est forcément plus rapide qu'au post #2 puisque les fichiers sont déjà ouverts.