XL 2016 Création fichier CSV

ZZ59264 · 19 Décembre 2021

Bonjour au forum,

Je joins un fichier à ma demande de création d'un fichier CSV à partir d'un tableau,

Merci d'avance pour votre aide,

Cordialement,

job75 · 20 Décembre 2021

Cette macro est la plus rapide :

VB:

Sub ExportCSV()
    Dim t, chemin$, NomFichier$
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy_mm_dd")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets("CSV").ListObjects(1).DataBodyRange
        Workbooks.Add 'nouveau document
        [A1].Resize(.Rows.Count, .Columns.Count) = .Value 'copie les valeurs
    End With
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox Timer - t
End Sub

Toujours sur 900 000...

Efgé · 28 Décembre 2021

Bonjour à tous
Avec ce code, sur ma machine sous XL 2007 et pour 900 000 lignes j'arrive à 7 secondes.
Si job75 veux bien nous donner le chrono sur sa machine...

VB:

Sub export()
Dim Tbl As Variant, TblTemp As Variant
Dim FileNumber&, i&, j&
Dim chemin$
Dim T!
T = Timer
FileNumber = FreeFile
chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
'chemin = "P:\AP\5 B\5 CSV IMPORT\"
chemin = chemin & "Export_" & Sheets("EN TETE").Cells(2, 37) & Format(Date, "_YYYY_MM_DD") & ".csv"
Tbl = ListObjects("CSV").DataBodyRange

Open chemin For Output As #FileNumber
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))
    For j = LBound(Tbl, 2) To UBound(Tbl, 2)
        TblTemp(j) = Tbl(i, j)
    Next j
    Print #FileNumber, Join(TblTemp, ";")
Next i
Close #FileNumber
MsgBox Timer - T
End Sub

Cordialement

ChTi160 · 28 Décembre 2021

Bonjour le Fil
Efgé
Pourquoi redimensionner le tableau x fois dans la Boucle ?

VB:

For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))'Ici'

et pas une fois avant !

Code:

ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))'Ici'
For i = LBound(Tbl, 1) To UBound(Tbl, 1)

je n'ai peut être pas compris Lol
jean marie

Efgé · 28 Décembre 2021

Re
Bonjour @ChTi160
Pour écraser les valeurs déjà présentes.
Mais tu as raison, j'aurais dû faire sans.
D'ailleurs on descend à 6 secondes.

VB:

Sub export()
Dim Tbl As Variant, TblTemp As Variant
Dim FileNumber&, i&, j&
Dim chemin$
Dim T!

T = Timer
FileNumber = FreeFile
chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
'chemin = "P:\AP\5 B\5 CSV IMPORT\"
chemin = chemin & "Export_" & Sheets("EN TETE").Cells(2, 37) & Format(Date, "_YYYY_MM_DD") & ".csv"
Tbl = ListObjects("CSV").DataBodyRange
ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))

Open chemin For Output As #FileNumber
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    For j = LBound(Tbl, 2) To UBound(Tbl, 2)
        TblTemp(j) = Tbl(i, j)
    Next j
    Print #FileNumber, Join(TblTemp, ";")
Next i
Close #FileNumber
MsgBox Timer - T
End Sub

Cordialement

patricktoulon · 28 Décembre 2021

Bonjour à tous
pour commencer pensez que tout le monde n'a pas la même version d'excel
chez moi par exemple excel 2013
dans un module standard :cette ligne plante

VB:

Tbl = ListObjects("CSV").DataBodyRange

pour la simple et bonne raison
que chaque feuille a sa propre collection listobjects

VB:

Tbl = sheets("taratata").ListObjects("CSV").DataBodyRange

par contre si vous utilisez le range il n'y a pas de soucis (je l'avais déjà dis me semble t il )
car un range("CSV") il ne peut y en avoir qu'un seul
avec range ou que l'on soit dans les modules la plage est bien ciblée

VB:

Sub export()
Dim Tbl As Variant, TblTemp As Variant, FileNumber&, i&, j&, chemin$, T#

T = Timer
FileNumber = FreeFile
chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
'chemin = "P:\AP\5 B\5 CSV IMPORT\"
chemin = chemin & "Export_" & Sheets("EN TETE").Cells(2, 37) & Format(Date, "_YYYY_MM_DD") & ".csv"
Tbl = Range("CSV").Value
ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))

Open chemin For Output As #FileNumber
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    For j = LBound(Tbl, 2) To UBound(Tbl, 2)
        TblTemp(j) = Tbl(i, j)
    Next j
    Print #FileNumber, Join(TblTemp, ";")
Next i
Close #FileNumber
MsgBox Timer - T & vbCrLf & "sur  " & i & " lignes et " & j & " colonnes"
End Sub

donc pour 10000 lignes sur 10 colonnes ça donne environ 0,200 millisecondes pour @Efgé

job75 · 28 Décembre 2021

Bonjour à tous,

Chez moi sur 900 000 lignes la macro du post #48 d'Efgé s'exécute en 5,7 secondes.

A+

Efgé · 28 Décembre 2021

iRe
Merci @job75 pour le test.
@patricktoulon

patricktoulon à dit:
chez moi par exemple excel 2013
dans un module standard :cette ligne plante

VB:

Tbl = ListObjects("CSV").DataBodyRange

Exact. J'ai testé le code dans le module de la feuille, donc je n'ai pas rencontré de souci.
Dans un module standart, tu as raison il faut spécifier la feuille.

Cordialement

patricktoulon · 28 Décembre 2021

re
et oui tandis qu'avec range("CSV") tu passera partout
et ça te donne la même chose que le databodyrange
la( lecture /écriture )dans un listobject est parfois plus facile par le membre range, parfois par la collection listobjects
perso je suis du genre a me simplifier les choses
une lecture globale sera plus simple avec le membre range
finalement la collection listobjects n'est utile que quand on veux travailler dans le détail (ligne, colonne ajouter,supprimer,etc....) car c'est plus facile de terminer les cibles
et meme que l'on peut passer d'un membre à l'autre selon le besoins

exemple
je veux l'object listobjects("CSV") je ne passe pas par la collection listobjects
je passe là encore par le range avec cette fois ci la propriété "listobject"(sans le "s")

VB:

set monlistobject=range("CSV").listobject'passe partout

avec ça je peux utiliser les fonctions pour le listobject sans être passé par la collection listobjects d'une feuille puisque mon object est un listobject et non un Range

XL 2016 Création fichier CSV

ZZ59264

XLDnaute Occasionnel

Pièces jointes

job75

Efgé

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires