Microsoft 365 Import informations de fichiers fermés

Usine à gaz · 6 Mars 2021

Bonjour à toutes et à tous,
Je vous souhaite un très beau WE

Il y a quelques temps, mon cher job75 m'avait concocté un code pour importer des informations en provenances de fichiers fermés.
Evidemment, c'est nickel et encore un super MERCI

Je me trouve maintenant devant un autre besoin, bien plus compliqué me semble-t-il, et je n'arrive pas à modifier le code pour l'adapter à ce nouveau besoin.
Voici mon petit exposé :
Pour 6 personnes, j'ai chaque mois un fichier de facturation
Dans chaque fichier de facturation j'ai des onglets nommés avec les Noms des clients facturés.
Chaque mois, les fichiers de facturation sont sauvegardés et un nouveau fichier est créé le mois suivant avec sa date de facturation.
les noms des fichiers (la partie "Sonda 2021 02 28") change :
exemples :
isitelFacturation Charlotte 2019 01 07
isitelFacturation Stephanie 2020 02 03
isitelFacturation Imen 2020 07 05
isitelFacturation Sonda 2018 04 etc.

Dans chaque fichier, chaque onglet a un nom différent
A ce jour, j'ai environ 200 fichiers "isitelFacturation", ce qui représente environ plus de 3000 onglets - moyenne 5 lignes par onglet = 15000 lignes à importer
Tous les fichiers sont identiques et les onglets également.

Tout en continuant à chercher, je me permets de vous solliciter à nouveau pour m'aider à cette adaptation.
Je joins les fichiers test EN POST#2 contenant ;
- le code de Job75 en feuille "Code_Job75",
- mon besoin en feuille "Besoin"
- le fichier "isitelFacturation Sonda 2021 02 28" qui contient les informations à importer

Avec mes remerciements,
Amicalement,
lionel,

job75 · 8 Mars 2021

Bonjour Lionel, soan, le forum,

Usine à gaz à dit:
Il fonctionne nickel mais c'est long.

Oui ExecuteExcel4Macro sur toutes les cellules prend beaucoup trop de temps.

Pour aller vite il faut utiliser des formules de liaison matricielles, fichier (4) :

VB:

Sub Consolider()
Dim t#, chemin$, fichier$, feuille$, ncol%, dest As Range, form$, h As Variant, n&
t = Timer
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "isitelFacturation*.xlsm") '1er fichier du dossier
If fichier = "" Then MsgBox "Aucun fichier de facturation trouvé..."
feuille = "SuiviRDV"
ncol = 26 'nombre de colonnes à copier dans la feuille source (A:Z)
Set dest = Sheets("Consolidation").[A1] '1ère cellule du tableau, à adapter
Application.ScreenUpdating = False
If...

job75 · 7 Mars 2021

Bonjour Lionel, le forum,

75 minutes c'est en effet énorme pour seulement 200 fichiers.

J'avais testé avec 200 fichiers identiques et seulement 1200 lignes importées => 75 secondes.

Quant à ta liste de clients on peut toujours l'essayer, combien de noms ?

Mets-la dans le fichier Consolidation.xlsm pour que je puisse modifier la macro.

A+

Usine à gaz · 7 Mars 2021

Bjr Gérard,
Je n'avais pas pensé à dire que les fichiers facturations sont également très codés et contiennent des onglets de fonctionnement et de calculs autres que les noms des Clients :
Feuilles : RecapFact - Données - suiviRdV - CltsFinis
et ton code importe certaines informations contenues dans ces feuilles, c'est peut-être pour cela que c'est très long ??? et peut-être aussi le fait de les ouvrir et de les refermer ?

Quant à la liste des Clients, il y en a moins de 500 (pour l'instant lol).
Merci Gérard pour tout ce que tu fais
lionel,

Usine à gaz · 7 Mars 2021

Je cherche à faire des fichiers sans données confidentielles avant de te les envoyer

Usine à gaz · 7 Mars 2021

Re Bonjour Gérard,
En cherchant à simplifier l'importation, je pense que j'ai trouvé une importation bien plus simple :

Dans le fichier "isitelFacturation Sonda 2021 02 28" (comme dans tous les fichiers de facturation),
Il y a un onglet qui contient toutes les infos, c'est l'onglet "suiviRdV", il suffit d'importer les lignes NON VIDES à partir de la ligne 4 de la colonne "A à Z" et ça ira très bien pour mon besoin.
lionel,

job75 · 7 Mars 2021

Usine à gaz à dit:
Dans le fichier "isitelFacturation Sonda 2021 02 28" (comme dans tous les fichiers de facturation),
Il y a un onglet qui contient toutes les infos, c'est l'onglet "suiviRdV", il suffit d'importer les lignes NON VIDES à partir de la ligne 4 de la colonne "A à Z" et ça ira très bien pour mon besoin.

D'accord alors si tu veux la macro dépose le fichier source avec tous ses onglets.

Usine à gaz · 7 Mars 2021

Bsr Gérard,

Merci pour ta réponse.
N'ayant pas pu supprimer les données confidentielles des fichiers, je les ai déposé sur https://www.cjoint.com/
et je me suis permis de t'envoyer un message privé avec les codes de récupération.

job75 · 8 Mars 2021

Dans ce fichier (3) la macro importe les données des fichiers sources sans les ouvrir :

VB:

Sub Consolider()
Dim t#, chemin$, fichier$, feuille$, ncol%, resu(), form$, i&, v, n&, j%
t = Timer
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "isitelFacturation*.xlsm") '1er fichier du dossier
If fichier = "" Then MsgBox "Aucun fichier de facturation trouvé..."
feuille = "SuiviRDV"
ncol = 26 'nombre de colonnes à copier dans la feuille source (A:Z)
ReDim resu(1 To Rows.Count, 1 To ncol + 1) '1 colonne de plus
While fichier <> ""
    form = "'" & chemin & "[" & fichier & "]" & feuille & "'!R"
    For i = 4 To Rows.Count
        v = ExecuteExcel4Macro(form & i & "C1")
        If v = 0 Then Exit For
        n = n + 1
        resu(n, 1) = fichier 'colonne A
        resu(n, 2) = v 'colonne B
        For j = 2 To ncol
            v = ExecuteExcel4Macro(form & i & "C" & j)
            If v <> 0 Then resu(n, j + 1) = Trim(v)
    Next j, i
    fichier = Dir 'fichier suivant
Wend
'---restitution---
With Sheets("Consolidation")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2] '1ère cellule de testination, à adapter
        If n Then
            With .Resize(n, ncol + 1)
                .Value = resu
                .Borders.Weight = xlHairline
                .BorderAround Weight:=xlThin 'pourtour
            End With
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol + 1).Delete xlUp 'RAZ en dessous
    End With
    .Columns.AutoFit 'ajustement largeurs
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "Consolidation"
End Sub

Comme demandé au post #19 seule la feuille SuiviRDV est traitée, colonnes A à Z.

Bonne nuit.

Usine à gaz · 8 Mars 2021

Bonjour Gérard, le Forum,

Je te remercie pour ton fichier
Il fonctionne nickel mais c'est long.
j'ai importé à partir du fichier "facturation" que je t'ai envoyé et il a mis un peu plus de 8secondes.
J'ai donc lancé pour tous les fichier (environ 200) et depuis 20 mn il n'a pas terminé.
Je le coupe car je dois préparer ma journée de travail et je le relancerai ce soir pour voir exactement le temps de traitement et je te dirai.

PS : merci de ne pas m'avoir parlé de ma codification du fichier de facturation ... mais il fonctionne lol.
Bonne journée,
lionel,

soan · 8 Mars 2021

Bonjour Lionel, job75, le fil,

je suis en train de préparer une thèse sur la mystérieuse dilatation du temps qui se produit dès qu'on franchit le seuil de ton usine à gaz ; d'après le post ci-dessus, il semblerait que le temps ralentisse dans un facteur de 60, car 75 secondes deviennent 75 minutes, et comme 1 mn = 60 secondes...

dans un des épisodes de X-Files, j'avais vu que si le temps ralentit ou s'arrête, et que tu ne peux pas expliquer comment une tranche de temps a mystérieusement disparu, alors c'est probablement car tu t'es fait enlever par des extra-terrestres, même si tu n'en n'as plus le souvenir.

si un jour tu en as l'occasion, je te conseille de lire le livre Le Soleil va mourir, de Christian GRENIER ; je te laisse lire la fiche descriptive, y compris le 2ème cadre ; l'astrophysicien qui a proposé d'isoler la Terre dans une sorte de bulle protectrice s'appelle Messigny, d'où le nom de sa solution : « la Ceinture de Messigny » (créée par des satellites placés en orbite géostationnaire autour de la Terre) ; cette ceinture fait que le temps est ralenti sur Terre dans une proportion vraiment très importante ; si j'me rappelle bien, c'était : 1 seconde de temps normal = 24 heures dans le temps ralenti de Messigny ; ça a permis aux Terriens de gagner le temps qui manquait pour trouver une solution au fait que le Soleil allait exploser à moyen terme, suite à l'envoi de déchets radioactifs vers le Soleil (pour les recycler) ; finalement, ils ont bien trouvé une solution ; je te laisse lire le livre pour découvrir laquelle.

soan

job75 · 8 Mars 2021

Bonjour Lionel, soan, le forum,

Usine à gaz à dit:
Il fonctionne nickel mais c'est long.

Oui ExecuteExcel4Macro sur toutes les cellules prend beaucoup trop de temps.

Pour aller vite il faut utiliser des formules de liaison matricielles, fichier (4) :

VB:

Sub Consolider()
Dim t#, chemin$, fichier$, feuille$, ncol%, dest As Range, form$, h As Variant, n&
t = Timer
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "isitelFacturation*.xlsm") '1er fichier du dossier
If fichier = "" Then MsgBox "Aucun fichier de facturation trouvé..."
feuille = "SuiviRDV"
ncol = 26 'nombre de colonnes à copier dans la feuille source (A:Z)
Set dest = Sheets("Consolidation").[A1] '1ère cellule du tableau, à adapter
Application.ScreenUpdating = False
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
While fichier <> ""
    form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
    h = ExecuteExcel4Macro("MATCH(9^9," & form & "C1)") 'recherche du dernier nombre
    If IsNumeric(h) Then
        If h > 3 Then 'à partir de la ligne 4
            With dest(2, 2).Offset(n).Resize(h - 3, ncol)
                .Columns(0) = fichier 'colonne A supplémentaire
                .FormulaArray = "=TRIM(" & form & "R4C1:R" & h & "C" & ncol & ")" 'formule de liaison matricielle
                .Value = .Value 'supprime les formules
            End With
            n = n + h - 3
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
'---mise en forme---
If n Then
    With dest(2).Resize(n, ncol + 1)
        .Borders.Weight = xlHairline
        .BorderAround Weight:=xlThin 'pourtour
    End With
End If
dest(2).Offset(n).Resize(Rows.Count - n - dest.Row, ncol + 1).Delete xlUp 'RAZ en dessous
dest.Parent.Columns.AutoFit 'ajustement largeurs
With dest.Parent.UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "Consolidation"
End Sub

Avec 200 fichiers la durée d'exécution devrait être d'environ 20 secondes.

A+

Usine à gaz · 8 Mars 2021

Bjr Gérard,

Merci pour ta gentillesse et C'est nickel :

Pour 200 fichiers, c'est tout à fait acceptable,
"Avec 200 fichiers la durée d'exécution devrait être d'environ 20 secondes."
lol, t'es dans mon ordi ?
Bonne journée,
lionel

job75 · 8 Mars 2021

Je viens de voir que .Replace 0, "", xlWhole 'efface les zéros est inutile, je vais le retirer du post #25.

Usine à gaz · 8 Mars 2021

lol, toujours aussi pointilleux !
J'ai rencontré mon Maître lol

Usine à gaz · 8 Mars 2021

Re-Gérard
.Replace 0, "", xlWhole ' : Ce n'est pas gênant pour mon besoin
Bon sang, je viens de refaire le test en effaçant au préalable toutes les lignes et :
importation faite en 10 secondes et des poussières,

Usine à gaz · 29 Janvier 2022

Bonsoir à toues et à tous,
Je vous souhaite une belle fin de journée

Il y a déjà longtemps, mon cher @job75 m'avait fait un code que j'avais "un peu" modifié pour l'adapter exactement au besoin de mon fichier de travail.
Il fonctionne parfaitement :

VB:

Option Explicit
Sub Import()
Dim t#, chemin$, fichier$, feuille$, ncol%, dest As Range, form$, h As Variant, n&
t = Timer
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "fichier*.xlsm") '1er fichier du dossier
If fichier = "" Then MsgBox "Aucun fichier de facturation trouvé..."
feuille = "RdV_transfert"
ncol = 11 'nombre de colonnes à copier dans la feuille source (A:Z)
Set dest = Sheets("RdV_transfert").[A1] '1ère cellule du tableau, à adapter
Application.ScreenUpdating = False
If dest.Parent.FilterMode Then dest.Parent.ShowAllData 'si la feuille est filtrée
While fichier <> ""
form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
h = ExecuteExcel4Macro("MATCH(9^9," & form & "A1)") 'recherche du dernier nombre
If IsNumeric(h) Then
If h > 3 Then 'à partir de la ligne 4
With dest(2, 2).Offset(n).Resize(h - 3, ncol)
.Columns(0) = fichier 'colonne A supplémentaire
.FormulaArray = "=TRIM(" & form & "R4C1:R" & h & "C" & ncol & ")" 'formule de liaison matricielle
.Value = .Value 'supprime les formules
End With
n = n + h - 3
End If
End If
fichier = Dir 'fichier suivant
Wend
'---mise en forme---
If n Then
With dest(2).Resize(n, ncol + 1)
.Borders.Weight = xlHairline
.BorderAround Weight:=xlThin 'pourtour
End With
End If
dest(2).Offset(n).Resize(Rows.Count - n - dest.Row, ncol + 1).Delete xlUp 'RAZ en dessous
'dest.Parent.Columns.AutoFit 'ajustement largeurs
With dest.Parent.UsedRange: End With 'actualise la barre de défilement verticale
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "RdV_transfert"
End Sub

Aujourd'hui, j'ai besoin de l'utiliser pour un autre besoin que je décris ci-dessous :
Importer à partir des classeurs (classeurs sources)
fichier_Charlotte : onglet RdV_transfert
fichier_Lionel : onglet RdV_transfert
de A2 à K2 jusqu'à dernière ligne NON vide
----------------------------------------------------------------------------------
Importer
si C2 = date (aujourdhui()) et si écart de jours entre B2 et C2 est > à 3
Important : B2 et C2 ne sont pas au même format (pour le calcul de l'écart)
..........Sinon, ne pas importer

Classeur cible
SMS_jour test : onglet RdV_transfert

Tous les onglets "RdV_transfert " des fichiers sont identiques

Voilà plusieurs jours que je tente de l'adapter mais je n'y arrive pas car le niveau de technicité du code ne me permets pas de le comprendre.

Pourriez-vous m'aider ?
En cas, je joins les fichiers et je continue d'essayer
Avec mes remerciements,
Amicalement,
lionel

Microsoft 365 Import informations de fichiers fermés

Usine à gaz

XLDnaute Barbatruc

job75

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

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Discussions similaires