A/S: Excel 2007 à plus de 1 millions de lignes
Rebonjour,
Me demande s'il y a un module permettant l'ouverture d'une feuille à 12 millions de lignes.
Je dispose actuellement d'office 2007.
Crdt
C'est quoi ta question au juste ?
Je t'ai donnée une solution ici : https://forum.excel-pratique.com/viewtopic.php?f=2&t=130537
où tu dis :
Je me demande s'il y a un module excel ou code VBA permettant de fractionner une feuille contenant 1 millions de lignes vers plusieurs fichiers, et ce selon les variables d'une colonne choisie.
et maintenant c'est :
Me demande s'il y a un module permettant l'ouverture d'une feuille à 12 millions de lignes
et toute à l'heure ça va être combien 50 millions ?
Tu as Excel 2007 donc, nombre de lignes maxi 1 048 576
Merci Theze pour ta 1er réponse qui ma permis de traiter des fichiers excel de 1 million de lignes déja issu du fractionnement d'un fichier csv de 12 millions de lignes. C donc un temps considérable gagné grace a votre code vba. Pour ce qui es de ma deuxieme question mon objectif est donc de traiter directement le fichier source de 12 millions de ligne en appliquant votre code vba sans le fractionné. Mais malheurement j'apprend que xl 2007 ne le permet pas.
Bonjour,
Dans ce cas, utilises plutôt :
Open "Fichier" For Binary As #1
...
Close #1
ou même :
Open "Fichier" For Input As #1
...
Close #1
avec par exemple deux tableaux, dans un tu stockes les valeurs de ton fichier (les 12 millions de lignes) et dans l'autre, tu récupères les valeurs par rapport aux critères que tu colles ensuite dans les fichiers Excel à condition qu'il n'y ait pas plus de 1 048 576 lignes sinon, utiliser une seconde feuille du classeur.
pour récupérer les valeurs par rapport aux critères, il te faut boucler sur tout le tableau, il y a bien la fonction "Filter()" qui retourne un tableau du résultat du filtrage d'un autre tableau mais ça ne fonctionne que sur un tableau à une dimension !
Probablement que quelqu'un d'autre va te donner une meilleure solution.
Bonjour à tous
De toute façon même 365 à 1 million de lignes...
A partir de 2010 on peut passer par PowerQuery.
Sur 2007 (12 ans déjà !) tu peux tenter MsQuery.
Dans la mesure où on peut stocker des variables pour la requête dans le fichier Excel, je pense qu'on peut invoquer la requête par VBA mais toujours sous réserve que le résultat soit au maximum d'1 million de lignes
Cependant je n'ai pas trouvé les limitations de MsQuery dont à vérifier...
Bonjour kikim,
stl Theze & 78chris
voici un autre exemple,
Sub Transposer_Texte_SurPlusieursFeuilles()
'cocher la référence à: Microsoft Scripting Runtime
Dim ff As Integer, lignes() As String, Temp As String, Fichier As String
Dim tempo()
Dim nbr As Long, i As Long, j As Integer, sh As Integer
nbr = 4 'nombres de lignes à inscrire par feuille, maximun 1048576
ReDim Preserve tempo(nbr - 1)
ff = FreeFile
Fichier = "C:\Users\isabelle\Documents\Test1\TestLecture.txt" 'à adapter
Open Fichier For Binary As #ff
Temp = String(FileLen(Fichier), " ")
Get #ff, , Temp ' Récupère tout le fichier
Close #ff
lignes = Split(Temp, vbCrLf) 'sépare le texte en ligne
sh = 1 'premier onglet du fichier
For i = LBound(lignes) To UBound(lignes) Step nbr
For j = 0 To nbr - 1
tempo(j) = lignes(i + j)
Next j
Sheets(sh).[A1].Resize(nbr) = Application.Transpose(tempo)
If sh = Sheets.Count Then Sheets.Add After:=Sheets(Sheets.Count)
sh = sh + 1
Next i
End Sub
Bonjour le forum,
Je remercie tt le monde,
Je devais donc bien exprimer mon besoin, surtout étant nouveau en VBA.
En effet, je doit convertir un fichier CSV vers excel (12 millions de lignes), et par la suite. De ce faite je procède déja à fractionner le fichier CSV lui même et par la suite effectuer des filtres par colonne V pour avoir enfin des fichiers excel exploitables
I20100 : où cocher Microsoft Scripting Runtime SVP?
Partice3370: comment procéder via Word SVP?
78 Chris: je vais téléchargé et essayé avec MsQuery Merci
Merci encore une fois
Bonjour le fil,
@i20100:
Attention avec le format csv, on ne peut pas se contenter de : lignes = Split(Temp, vbCrLf)
En effet il est fréquent qu'un champ contienne un vbCrLf (notamment dans les adresse postales) et alors on se retrouve avec des lignes supplémentaires qui ne contiennent qu'un partie des champs.
Pour que le code fonctionne correctement, il faut impérativement tenir compte de l'identificateur de texte dont le nombre sur une ligne complète est toujours pair.
Re,
Une solution pour fractionner le csv avec un stream :
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
'
' Établir la référence à ADODB : Microsoft ActiveX Data Objects 6.1 Library
' Pour les valeurs de Stream.Charset, voir dans le registre : HKEY_CLASSES_ROOT\MIME\Database\Charset
'
Dim fAscii As ADODB.Stream '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\Test.csv" 'à adapter
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set fAscii = New Stream
With fAscii
' Définir le flux de données
.Charset = "ascii" '= "iso-8859-1"
.Mode = adModeReadWrite
.Type = adTypeText
.LineSeparator = 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
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?
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 "
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
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
Bonjour,
C'est quoi le message d'erreur ?
Note : mettre un très gros fichier sur le bureau n'est pas conseillé !
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