Microsoft 365 Import informations de fichiers fermés

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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,
 
Dernière édition:
Solution
Bonjour Lionel, soan, le forum,
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

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

Usine à gaz

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

XLDnaute Barbatruc
Supporter XLD
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,
 
Dernière édition:

job75

XLDnaute Barbatruc
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.
 

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Consolidation(3).xlsm
    23.6 KB · Affichages: 8

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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,
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Lionel, job75, le fil,

Image.jpg


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

job75

XLDnaute Barbatruc
Bonjour Lionel, soan, le forum,
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+
 

Pièces jointes

  • Consolidation(4).xlsm
    23.8 KB · Affichages: 10
Dernière édition:

Usine à gaz

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

Pièces jointes

  • SMS_jour test.xlsm
    37 KB · Affichages: 0
  • fichier_Charlotte.xlsm
    32.5 KB · Affichages: 0
  • fichier_lionel.xlsm
    32.6 KB · Affichages: 0

Discussions similaires

Réponses
13
Affichages
241

Statistiques des forums

Discussions
311 711
Messages
2 081 799
Membres
101 818
dernier inscrit
tiftouf5757