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,

 

[Usine à gaz]

OUI Gérard, ça semble logique pour le temps de recherche. Mais "globalement", je ne sais pas pourquoi mais c'est plus long chez moi que le code du post 2.
Le temps d'ouverture certainement.

Mais c'est déjà super comme ça.
Encore un "BIG" merci à toi

 

[job75]

Le temps d'ouverture certainement.

Tu es têtu, quand on clique sur le bouton il n'y a plus à ouvrir les fichiers !!!

 

[Usine à gaz]

LOL, je regarde ce que j'ai loupé

 

[Usine à gaz]

"Tu es têtu, quand on clique sur le bouton il n'y a plus à ouvrir les fichiers !!! "

Je dois être bouché à l'émeri"
Effectivement, il n'y a plus à les ouvrir mais il faut bien qu'il les ouvre avant et ça allonge le temps avant exécution ... non ?

 

[job75]

Effectivement, il n'y a plus à les ouvrir mais il faut bien qu'il les ouvre avant et ça allonge le temps avant exécution ... non ?

Oui mai cela se passe seulement à l'ouverture du fichier de la macro donc une seule fois.

 

[Usine à gaz]

OUI c'est bien ce que j'avais compris.

Encore merci Gérard, ça fonctionne très bien et ça me fait gagner un temps précieux de réponse

 

[Usine à gaz]

Décidément, j'ai un problème de réponse.

C'est ce que j'avais remarqué et ça fonctionne aussi bien sûr,

Toutefois, je vais rester sur le code du post 2 qui m'apporte déjà un gain de temps important de réaction.
Merci Gérard
Lionel,

 

[laurent950]

Bonsoir,
la solution pour lire et extraire les informations sans ouvrir Excel :
avec classeur qui contient d’excellents codes de SilkyRoad qui me semblent proches de mon besoin et que j'ai donc adapter.
Il y a deux points qui peuvent être amélioré :
Ajouter a la requête de recherche de numéro de téléphone WHERE
l'extraction de la variable tableau avec : exemple ci-dessous
- Range("B6").Resize(1, UBound(Tblo, 2)).Value = Application.Index(Tblo, y)
dans ce cas l'indice n’appartient pas à la sélection
J'ai donc contourné se problème (donc a amélioré)

Ps : Le code est dans le fichier excel : Import valeur cherchée

' ***************************************************************************************************************************

Pour exemple les noms des classeurs 1 / 2 / 3 sont stocké dans une variable tableau
' Nom des classeurs fermer pour aller lire les informations.
Dim TabClassFermer(1 To 3) As String
'Pour Exemple :
TabClassFermer(1) = "Classeur_1.xlsm"
TabClassFermer(2) = "Classeur_2.xlsm"
TabClassFermer(3) = "Classeur_3.xlsm"

le chemin sera a modifier :
Const CstPath As String = "C:\Users\laure\Desktop\lire classeur fermer vba\"

Idem l'endroit ou on colle le tableau
Sheets("Résultat").Cells(Sheets("Résultat").Cells(65536, 9).End(xlUp).Row + 1, 9)

etc. a adapter selon vos fcichiers

Laurent

 

[Usine à gaz]

Bonjour laurent950, Gérard, le forum,

Merci pour m'avoir répondu
Je vais regarder dans la journée.
Amicalement,
arthour973,

 

[Usine à gaz]

Re-Bonjour,

@laurent950
Je ne trouve pas l'extension nécessaire :

 

[job75]

Bonjour Lionel, laurent950, le forum,

Je ne peux pas non plus tester la solution (compliquée) de Laurent car je n'ai pas Access.

Il faudrait indiquer la durée des calculs avec 3 fichiers sources de 18 000 lignes.

Bon voyez ce fichier (2) et cette macro qui n'ouvre pas les fichiers :

Sub Recherche()
Dim tel$, chemin$, fichier$, resu(), aux As Worksheet, f$, h&, 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
Application.DisplayAlerts = False
Set aux = Worksheets.Add 'feuille auxiliaire
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        f = "'" & chemin & "[" & fichier & "]Donnees'!"
        h = ExecuteExcel4Macro("MATCH(9^99," & f & "C14)")
        aux.[A1].Resize(h, 27).FormulaArray = "=" & f & "R1C9:R" & h & "C35" 'formule de liaison matricielle
        tablo = aux.[A1].Resize(h, 27) 'matrice, plus rapide
        For i = 1 To h
            If CStr(tablo(i, 6)) = tel Or CStr(tablo(i, 7)) = tel Then
                n = n + 1
                For j = 1 To 27
                    If tablo(i, j) <> 0 Then resu(n, j) = tablo(i, j)
                Next j
            End If
        Next i
        aux.Cells.ClearContents
    End If
    fichier = Dir
Wend
aux.Delete
'---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

Avec 3 fichiers sources de 18 000 lignes l'exécution se fait chez moi en 8,7 secondes.

C'est moins rapide qu'avec la macro du post #2 qui ouvre les fichiers.

A+

 

[laurent950]

Bonjour,
Peut être que si cette case est décoché ?
- "MANQUANT : microsoft access 15 object library"
Le programme fonctionne ?

Autres Hypothèse :
Access est installé sur votre poste ?

Question Votre version Office est laquelle ?

Pour évité de bouclé et de gagné du temps et récupérer que les lignes correspondante la requête serait celle-ci
Extraction.Requete = "SELECT * FROM [" & CstFeuil & "$] WHERE tel1 = " & RechTel & " OR " & "tel2 = " & RechTel & ";"

C'est dommage car le te temps de réponse sur 3 fichiers de 18000 lignes chacune est quasi instantané !

Laurent

 

[Usine à gaz]

Bonjour Gérard,
Merci d'être encore là
ça fonctionne évidemment
Je vais adapter à mes fichiers de travail et je te dis.
Lionel,

 

[Usine à gaz]

Re-Bonjour laurent950,

Version office 2016 mais je n'ai pas acces

 

[laurent950]

Re-Bonjour laurent950,

Version office 2016 mais je n'ai pas acces

si vous avez la possibilité d'installer Access sur votre poste ça peux résoudre le soucis.