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

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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,
 

Pièces jointes

  • Classeur_1.xlsm
    11.5 KB · Affichages: 12
  • Classeur_2.xlsm
    11.5 KB · Affichages: 11
  • Classeur_3.xlsm
    11.5 KB · Affichages: 9
  • SilkyRoad.xlsm
    22.4 KB · Affichages: 16
  • Import_Valeur_Cherchée.xlsm
    25.4 KB · Affichages: 15
Dernière édition:

laurent950

XLDnaute Accro
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
 

Pièces jointes

  • Import_Valeur_Cherchée.xlsm
    137.2 KB · Affichages: 7
  • Classeur_3.xlsm
    11.6 KB · Affichages: 3
  • Classeur_2.xlsm
    12.3 KB · Affichages: 3
  • Classeur_1.xlsm
    11.7 KB · Affichages: 3
  • Cocher les Options VBA Excel.JPG
    Cocher les Options VBA Excel.JPG
    70.4 KB · Affichages: 9
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-Bonjour,

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

VBAPProject.jpg
 

job75

XLDnaute Barbatruc
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 :
VB:
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+
 

Pièces jointes

  • Classeur_1.xlsm
    16.8 KB · Affichages: 14
  • Classeur_2.xlsm
    16.8 KB · Affichages: 11
  • Classeur_3.xlsm
    16.8 KB · Affichages: 10
  • Import_Valeur_Cherchée(2).xlsm
    26.3 KB · Affichages: 4
Dernière édition:

laurent950

XLDnaute Accro
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
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345