A/S: Excel 2007 à plus de 1 millions de lignes Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
k
kikim
Jeune membre
Jeune membre
Messages : 23
Inscrit le : 6 octobre 2019
Version d'Excel : 2007

Message par kikim » 7 octobre 2019, 14:32

Bonjour le fil,
merci patrice33740 pour la réponse,
Etant nouveau et bleu en vba, j'ai copié et collé intégralement ta macro ( à partir de "option expicit" jusqu'à "end sub") mais je ne peut l'executer. c'est quoi mon erreur SVP?
Avatar du membre
Patrice33740
Membre fidèle
Membre fidèle
Messages : 398
Appréciations reçues : 30
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2013, 2016

Message par Patrice33740 » 7 octobre 2019, 14:52

Re,

Il faut établir une référence à ADODB : Microsoft ActiveX Data Objects 6.1 Library
(Outils / Références ...)

Et adapter le chemin complet du fichier csv.

EDIT : csv n'est pas un format standardisé, il existe de nombreuses variations, il faut connaitre les séparateurs utilisés dans ton csv, j'ai considéré qu'il est au format anglais le plus courant : lignes séparées par CR LF, valeurs séparées par virgule, et texte identifié par "
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
k
kikim
Jeune membre
Jeune membre
Messages : 23
Inscrit le : 6 octobre 2019
Version d'Excel : 2007

Message par kikim » 7 octobre 2019, 15:19

Re,
Ci-joint deux lignes de mon fichier csv volumineux si ça peut facilité mon aide ;)
Désolé de vous informer que j'ai pas pu établir une référence à ADODB .. ça dépasse mes connaissances.
Merci d'avance
DO_0.csv
(1.1 Kio) Téléchargé 2 fois
Avatar du membre
Patrice33740
Membre fidèle
Membre fidèle
Messages : 398
Appréciations reçues : 30
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2013, 2016

Message par Patrice33740 » 7 octobre 2019, 15:44

Re,

Le même sans avoir besoin d'établir la référence à ADODB :
Option Explicit
Option Private Module
Public Const sepV$ = ","                                    'séparateur de valeurs
Public Const sepL$ = vbCrLf                                 'séparateur de lignes
Public Const idTxt$ = """"                                  'identificateur de texte chr(34)

Public Sub Enregistrer()
' Lecture ligne à ligne d'un [très gros] fichier au format csv encodé Ascii
'
' Pour les valeurs de Stream.Charset, voir dans le registre : HKEY_CLASSES_ROOT\MIME\Database\Charset
'
Dim fAscii As Object              'flux de données Ascii (ANSI)
Dim wbk As Excel.Workbook         'Classeur résultat
Dim cel As Range                  'cellule destination
Dim nom As String                 'nom fichier
Dim txt As String                 'texte
Dim lgn As String                 'ligne
Dim lgr As Long                   'longueur
Dim noL As Long                   'numéro de ligne
Dim noF As Integer                'numéro de fichier

  nom = "D:\Temp\DO_0.csv"   'à adapter
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set fAscii = CreateObject("ADODB.Stream")
  With fAscii
    ' Définir le flux de données
    .Charset = "ascii"        '= "iso-8859-1"
    .Mode = 3                 'adModeReadWrite
    .Type = 2                 'adTypeText
    .LineSeparator = -1       'adCRLF
    ' Ouvrir le flux et charger le contenu du fichier
    .Open
    .LoadFromFile nom
    Do Until .EOS
      If noL = 0 Then
        Set wbk = Application.Workbooks.Add(xlWBATWorksheet)
        Set cel = wbk.Worksheets(1).Range("A1")
      End If
      noL = cel.Row
      txt = .ReadText(-2)         '-2 = une ligne
      lgn = lgn & txt
      lgr = Len(lgn) - Len(Replace(lgn, idTxt, ""))
      If (lgr Mod 2) = 0 Then
        ' la ligne est complète
        Call EcrireLigneCSV(lgn, cel)
        Set cel = cel.Offset(1)
        txt = "": lgn = ""
      Else
        ' la ligne est incomplète
        lgn = lgn & sepL
      End If
      If noL = 1000000 Then
        noF = noF + 1
        wbk.SaveAs ThisWorkbook.Path & "\fichier_" & noF & ".xlsx"
        wbk.Close False
        Set wbk = Nothing
        Set cel = Nothing
        noL = 0
      End If
    Loop
    .Close
    If noL > 0 Then
      noF = noF + 1
      wbk.SaveAs ThisWorkbook.Path & "\fichier_" & noF & ".xlsx"
      wbk.Close False
      Set wbk = Nothing
      Set cel = Nothing
    End If
  End With
  Set fAscii = Nothing
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  
End Sub

Private Sub EcrireLigneCSV(lgn As String, cel As Range)
' Ecriture d'une ligne d'un fichier au format csv
'
Dim txt As String                 'texte
Dim frm As String                 'formule (champ)
Dim lgr As Long                   'longueur
Dim nbC As Long                   'nombre de colonnes
Dim t As Variant                  'Tableau des champs bruts
Dim i As Long                     'index
  
  If lgn = "" Then Exit Sub
  t = Split(lgn, sepV)
  For i = LBound(t) To UBound(t)
    frm = txt & t(i)
    lgr = Len(frm) - Len(Replace(frm, idTxt, ""))
    If (lgr Mod 2) = 0 Then
      ' le champ est complet
      If Mid(frm, 1, 1) = idTxt Then
        ' le texte est délimité, enlever les délimiteurs
        frm = Mid(frm, 2, Len(frm) - 2)
        ' remplacer les doubles délimiteurs pas un simple délimiteur
        frm = Replace(frm, idTxt & idTxt, idTxt)
      End If
      cel.Offset(0, nbC).FormulaLocal = frm
      txt = "": nbC = nbC + 1
    Else
      ' le champ est incomplet
      txt = txt & frm & sepV
    End If
  Next i

End Sub
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
k
kikim
Jeune membre
Jeune membre
Messages : 23
Inscrit le : 6 octobre 2019
Version d'Excel : 2007

Message par kikim » 8 octobre 2019, 11:12

Bonjour le forum,
Pacifique j'ai pris tes corrections en considération mais à l’exécution de la macro une erreur s'affiche (voir image), comment corrigé SVP? es ce une erreur du chemin du fichier CSV?
Capture.JPG
Avatar du membre
Patrice33740
Membre fidèle
Membre fidèle
Messages : 398
Appréciations reçues : 30
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2013, 2016

Message par Patrice33740 » 8 octobre 2019, 12:47

Bonjour,

C'est quoi le message d'erreur ?
Note : mettre un très gros fichier sur le bureau n'est pas conseillé !
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
k
kikim
Jeune membre
Jeune membre
Messages : 23
Inscrit le : 6 octobre 2019
Version d'Excel : 2007

Message par kikim » 8 octobre 2019, 13:59

Bonjour, effectivement Pacifique33740 ta raison!
j'ai déplacé le fichier vers le repertoire D est ça marche très bien.
Seulement une lenteur, car le fichier CSV est de 1 millions de ligne (480 Mo). donc l'opération a pris 22 minutes.
Merci encore une fois
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message