Microsoft 365 importer une plage d'un fichier fermé

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion iliess
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
I

iliess

XLDnaute Occasionnel
bonjour
après une recherche dans le web j'ai trouvé macro suivant qui importe la valeur de la cellule A1 d'un ficher fermé.
j'ai modifier macro en remplacent la cellule A1 par la plage A1:K10000
mais ca marche pas
 

Pièces jointes

Trier par date Trier par votes
re
sauf conception particulière je n'en ai pas besoins
allez regarde
un peu plus de 3 secondes pour 52 000 lignes et 11 colonnes
demo.gif



le code magic'
VB: 
Option Explicit
Sub LitClasseurFermé()
    Dim Rsource As Range, Rdest As Range, chemin$, fichier$, Onglet$, nblignes&, T#, X

    chemin = ThisWorkbook.Path    'chemin du fichier source
    fichier = "JournalAux-97.xlsx"    'nom du fichier source
    Onglet = "JournalReport"    'feuille du fichier source
    T = Timer
    
    'on va chercher le nombre de ligne utiliser dans la feuille"journalreport" du  fichier fermé
    nblignes = GetLastRowInClosedFich(chemin & "\" & fichier, "A1:K500000", Onglet)


    Set Rsource = [A1:k1].Resize(nblignes)   ' plage du fichier source
    Set Rdest = ShDatas.[A1].Resize(Rsource.Rows.Count, Rsource.Columns.Count)    'destination
    X = LitChamp(Rdest, chemin, fichier, Onglet, Rsource)    'lance l'execution
    MsgBox Format(Timer - T, "#0.000 /sec") & vbCrLf & "pour " & nblignes & " lignes   et " & [K1].Column & " colonnes copiées "

End Sub

Function LitChamp(Rdest As Range, chemin, fichier, Onglet, Rsource As Range)
    Application.ScreenUpdating = False
    Rdest.FormulaArray = "=""""&'" & chemin & "\[" & fichier & "]" & Onglet & "'!" & CStr(Rsource.Address(0, 0))    'formule matricielle de liaison
    Rdest = Rdest.Value    'supression des formulesremplacement des formules par les valeurs
    Application.ScreenUpdating = True
End Function

'function pour connaitre  le nombre de lignes utilisées dans le fichier fermé
'patricktoulon sur Exceldownloads
'version 2.0
'date version : 26/02/2023
Function GetLastRowInClosedFich(fichier As String, Rng As String, Optional Feuille As String = "", Optional headerTable As Boolean = False)
    Dim HDR As String, RsTLigne As Integer, RsTCol As Integer
    Dim AdConn As Object, AdoComand As Object, rst As Object
    Set AdConn = CreateObject("ADODB.Connection"): Set AdoComand = CreateObject("ADODB.Command"): Set rst = CreateObject("ADODB.Recordset")
    AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1;"""
    AdoComand.ActiveConnection = AdConn
    If Feuille = "" _
       Then AdoComand.CommandText = "SELECT * from `" & Rng & "`" _
       Else AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & Rng & "`"
    rst.Open AdoComand, , 1, 1
    GetLastRowInClosedFich = rst.RecordCount
    AdConn.Close: Set rst = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
End Function

@job75 en fait non ta petite modif ne renvoie pas en texte c'est étonnant

voila @iliess tu a ta fonction
3 secondes sur 50 000 lignes 140 devrait faire moins de 10 secondes

au plaisir 😉
 
Vote positif 0 Vote négatif
re
job75 dans mon post #17 j'ai adapté ton astuce
j'ai gonflet son xlsx a plus de 50 000 lignes
la nouvelle fonction j'injecte A1 : K500 000
il me retourne 50012 lignes utilisée(ce qui est exact)
j'injecte donc les formule sur 50012 lignes et pas plus
comme ca on :
  1. perd un peu de temps a trouver la last ligne du fichier fermé
  2. mais on en gagne en ne faisant que le nombre de lignes necéssaires pour les formules
j'en ai profité pour voir pourquoi celle en macro4 ne fonctionnait pas tout du moins elle donnait un résultat loufoque
en fait c'est quelle n'aime pas les blancs en deux pleines
je l'ai donc repris et fait l'examen colonne par colonne
mais elle reste largement plus longue que celle avec adobd .connection

VB: 
Sub test()
    Dim chemin$, Fichier$, Rng As Range, Feuille$
    chemin = ThisWorkbook.Path          'chemin du fichier source
    Fichier = "JournalAux-97.xlsx"      'nom du fichier source
    Onglet = "JournalReport"            'feuille du fichier source
    Set Rng = [A1:K1].Resize(Rows.Count)              'plage (colonne)du fichier source a examiner
    
    MsgBox GetLastRowColInClosedFich(chemin, Fichier, Onglet, Rng)
End Sub

Function GetLastRowColInClosedFich(chemin$, Fichier$, Feuille, Rng As Range)
'collection fichiers fermé derniere ligne dans une colonne de fichiers fermé:patricktoulon
    Dim Addr$, Formule, n&, Max&
    For c = 1 To Rng.Columns.Count
        Addr = Rng.Columns(c).Address(, , xlR1C1)
         Formule = "'" & chemin & "\[" & Fichier & "]" & Feuille & "'!" & Addr
        On Error Resume Next
        n = ExecuteExcel4Macro("MATCH(""zzzzz""," & Formule & ")")    'dernière cellule texte en colonne D
        If n > Max Then Max = n
        On Error GoTo 0
    Next
    GetLastRowColInClosedFich = Max
End Function
 
Vote positif 0 Vote négatif
bonsoir les amis
et merci pour votre temps et votre aide
voici un resumé
poste #05 la durée d'exécution est de 173 sec
poste #07 la durée d'exécution est de 108 sec
poste #10 la durée d'exécution est de 65 sec
poste #17 la durée d'exécution est de 83 sec

et j'ai ajouter deux méthodes
la premier avec Power QUERY la durée d'exécution est de 28 sec
VB: 
Sub Power_Query()

With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
End With

Dim T#
T = Timer
    ActiveWorkbook.Queries.Add Name:="JournalReport", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(File.Contents(""C:\Users\ilies\Desktop\test\JournalAux.xlsx""), null, true)," & Chr(13) & "" & Chr(10) & "    JournalReport_Sheet = Source{[Item=""JournalReport"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & "    #""Type modifié"" = Table.TransformColumnTypes(JournalReport_Sheet,{{""Column1"", type any}, {""Column2"", type any}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type te" & _
        "xt}, {""Column6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", type any}, {""Column10"", type datetime}, {""Column11"", type any}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Type modifié"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""JournalReport"";Extended Properties=""""" _
        , destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [JournalReport]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "JournalReport"
        .Refresh BackgroundQuery:=False
        
    End With
Dim cn As WorkbookConnection, qry As WorkbookQuery
    On Error Resume Next
    For Each cn In ActiveWorkbook.Connections
        cn.Delete
    Next cn
    For Each qry In ActiveWorkbook.Queries
        qry.Delete
    Next qry
MsgBox "Durée " & Format(Timer - T, "0.00 \sec"), , "Import"
With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
End With

End Sub

la deuxième avec Les ADO_VBA la durée d'exécution est de 58 sec

Code: 
Sub ADO_VBA()
Dim cn As ADODB.connection
Dim oCat As ADOX.Catalog
Dim Filemane As String
Dim rst As ADODB.Recordset
Dim texte_SQL As String
Dim Ar() As String, i As Long
Dim T#
With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayScrollBars = False
        .ScreenUpdating = False
End With

T = Timer
Filemane = "C:\Users\ilies\Desktop\test\JournalAux.xlsx"
Set cn = New ADODB.connection
Set oCat = New ADOX.Catalog
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Filemane & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
Set oCat.ActiveConnection = cn

'For Each Feuille In oCat.Tables
'        i = i + 1
'        ReDim Preserve Ar(i)
'        Ar(i) = Feuille.Name
'Next Feuille



texte_SQL = "SELECT * FROM [JournalReport$]"
 
    Set rst = New ADODB.Recordset
    Set rst = cn.Execute(texte_SQL)
    


Range("A1").CopyFromRecordset rst

Set Feuille = Nothing
Set oCat = Nothing
cn.Close
Set cn = Nothing
MsgBox "Durée " & Format(Timer - T, "0.00 \sec"), , "Import"

With Application
        .Calculation = xlCalculationAutomatic
        .DisplayScrollBars = True
        .EnableEvents = True
        .ScreenUpdating = True
End With


End Sub

 
Vote positif 0 Vote négatif
re
c'est normal que le 10 soit moins long c'est du texte donc le format dans les colonnes n'est pas bon
le 17 tout est bon valeurs et format
le query.add (et non power query) c'est pareil c'est du texte c'est pas bon
c'est pour ca que je t'ai fait le 17 en variable tableau (pour l'autoconversion)
 
Vote positif 0 Vote négatif
patricktoulon à dit:
re
c'est normal que le 10 soit moins long c'est du texte donc le format dans les colonnes n'est pas bon
le 17 tout est bon valeurs et format
le query.add (et non power query) c'est pareil c'est du texte c'est pas bon
c'est pour ca que je t'ai fait le 17 en variable tableau (pour l'autoconversion)
Cliquez pour agrandir...
Bonsoir,
Query.Add et Power Query, c'est blanc bonnet et bonnet blanc...
Et pour le format "Texte", juste quelques variables à modifier dans l'étape :
VB: 
#""Type modifié""
Par exemple,
Code: 
{""Column6"", type text}
Remplacer text, par number...
Bonne soirée
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Dudu2
  • Résolu(e)
XL 2016 VBA - Trouver les feuilles d'un classeur fermé
12 13 14
Réponses
196
Affichages
3 K
patricktoulon
patricktoulon
M
  • Résolu(e)
XL 2021 Récupérer la valeur d’une cellule dans un classeur fermé
Réponses
5
Affichages
231
patricktoulon
patricktoulon
D
  • Résolu(e)
Microsoft 365 Récupérer la valeur d'une cellule d'un autre fichier
Réponses
7
Affichages
443
Diane272727
D
G
  • Résolu(e)
XL 2021 Transformer une formule en vba
2
Réponses
20
Affichages
750
kiki29
kiki29
M
  • Résolu(e)
Microsoft 365 Trouver une valeur dans une colonne
Réponses
7
Affichages
222
mikeduff
M
D
  • Résolu(e)
Microsoft 365 vba récupérer valeur cellule d'une autre feuille
Réponses
3
Affichages
229
Diane272727
D
P
  • Question Question
Microsoft 365 VBA excel cumuler des données alphanumériques
2
Réponses
16
Affichages
355
TooFatBoy
TooFatBoy
I
  • Résolu(e)
Microsoft 365 Copier-coller dans une plage avec des cellules masquées
Réponses
6
Affichages
553
sylvanu
sylvanu
Y
  • Résolu(e)
XL 2013 Bloquer la saisie dans une plage selon un critère
Réponses
6
Affichages
464
TooFatBoy
TooFatBoy
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
512
Attila451
A
vgendron
  • Résolu(e)
Power Query importer fichier CSV, dont le chemin est dans une cellule Excel
Réponses
11
Affichages
271
oguruma
oguruma
Tony44
  • Question Question
XL 2016 Transformer la mise en forme d'un tableau
2
Réponses
22
Affichages
506
Cousinhub
Cousinhub
fenec
  • Résolu(e)
Autres Copier/ Coller plage de données dans une autre cellule d'un même onglet
Réponses
6
Affichages
345
fenec
fenec
A
Excel Download aurait-il un concurrent ?
2
Réponses
21
Affichages
847
dysorthographie
dysorthographie
J
  • Question Question
XL 2016 recherche d'une valeur en fonction d'une plage de données
Réponses
2
Affichages
286
jeff2318
J
B
  • Question Question
XL 2016 Ramener une plage de données en fonction d'une cellule
Réponses
11
Affichages
588
JHA
J
yaka
  • Question Question
Microsoft 365 faire une copie d'un fichier stocké dans un sous sous... sous répertoire
2
Réponses
20
Affichages
618
TooFatBoy
TooFatBoy
treza88
  • Question Question
Microsoft 365 VBA : Problème de reconnaissance de variable avec fonction FIND
Réponses
2
Affichages
238
Dranreb
Dranreb
K
  • Question Question
XL 2019 Créer des utilisateurs sur un fichier VBA
Réponses
9
Affichages
301
cathodique
cathodique
D
  • Résolu(e)
Microsoft 365 chercher une cellule de couleur rouge dans une colonne
Réponses
4
Affichages
313
sylvanu
sylvanu
Retour