Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
XL 2019Fichier ".txt" de plus de 2.000.000 de lignes !
Vous voulez dire cette ligne suivant le code en poste #90
VB:
tablo = Split(txt, vbCrLf)
a remplacer par cela
ReDim tablo(2500000)
i = 0
While Not EOF(x)
Line Input #x, tablo(i)
i = i + 1
Wend
ReDim Preserve tablo(i - 1)
j'ai modifier en poste #90
'---création des fichiers---
Source = Array("Fichier2000000.txt") 'à adapter
t = Timer
For n = 0 To UBound(Source)
x = FreeFile
Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
txt = Input$(LOF(x), #x)
'tablo = Split(txt, vbCrLf)
ReDim tablo(2500000)
i = 0
While Not EOF(x)
Line Input #x, tablo(i)
i = i + 1
Wend
ReDim Preserve tablo(i - 1)
ub = UBound(tablo)
j'ai toujours Cela :
Toujours pareil sur l'ordinateur le moins performant en mémoire
Erreur d'exécution '14':
Espace de chaîne insuffisant
' -----------------------------------------------------------------------
' remplacer par : s'exécute en 13 secondes
' ----- >>>> tablo = Split(Input(LOF(x), #x), vbCrLf)
' remplacer par : qui s'exécute en 3,8 secondes.
ReDim tablo(2500000)
i = 0
While Not EOF(x)
Line Input #x, tablo(i)
i = i + 1
Wend
ReDim Preserve tablo(i - 1)
' remplacer par
' -----------------------------------------------------------------------
j'ai fais ce code :
Code:
Sub CréationFichierFournisseurAvecFiltreDate2Sur2()
' Module2Sur2
' Ultra rapide 54,48 Secondes
Dim t As Single
Dim fournisseurs As String
Dim filePath As String
Dim FSO As Object
Dim myFile As Object
Dim header As String
Dim fichier As String
Dim ID As String
Dim Values As String
Dim fileHandles As Object
Dim fileHandle As Variant
Dim datedeb As Date
Dim datefin As Date
Dim dateValue As Date
Dim splitValues As Variant
' Définir les dates de début et de fin
datedeb = CDate("01/03/2022")
datefin = Date
' Chemin du fichier texte à ouvrir
filePath = Application.GetOpenFilename("Fichiers TXT (*.txt), *.txt")
If filePath = "Faux" Then Exit Sub ' Si l'utilisateur annule
' Timer
t = Timer
' Dossier (Fichier Fournisseurs)
fournisseurs = ThisWorkbook.Path & "\Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs ' Crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
' Test si le sous-dossier n'est pas vide, suppression de tous les fichiers
While fichier <> ""
Kill fournisseurs & fichier
fichier = Dir
Wend
' Instanciation des variables FSO et myFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFile = FSO.OpenTextFile(filePath, 1)
' Lire l'entête
header = myFile.ReadLine
' Dictionnaire pour gérer les fichiers ouverts
Set fileHandles = CreateObject("Scripting.Dictionary")
' Boucle Lire le fichier ligne par ligne
Do While Not myFile.AtEndOfStream
Values = myFile.ReadLine
splitValues = Split(Values, ";")
ID = splitValues(0)
' Vérifier si la date est dans la plage spécifiée
dateValue = CDate(splitValues(7))
If dateValue >= datedeb And dateValue <= datefin Then
If Not fileHandles.Exists(ID) Then
' Créer le nom du fichier
fichier = fournisseurs & ID & ".csv"
' Ouvrir le fichier pour écriture séquentielle et stocker le handle dans le dictionnaire
fileHandle = FreeFile
Open fichier For Append As #fileHandle
fileHandles.Add ID, fileHandle
' Écrire l'entête
Print #fileHandle, header
Else
' Récupérer le handle du fichier déjà ouvert
fileHandle = fileHandles(ID)
End If
' Écrire la ligne dans le fichier correspondant
Print #fileHandle, Values
End If
Loop
' Fermer tous les fichiers ouverts
For Each fileHandle In fileHandles.Items
Close #fileHandle
Next fileHandle
' Libérer les objets
Set fileHandles = Nothing
' Fermer le fichier texte
myFile.Close
Set myFile = Nothing
' Afficher le temps écoulé
MsgBox "Création des fichiers " & Format(Timer - t, "0.00 \sec")
'Cells(8, 2) = Format(Timer - t, "0.00 \sec")
'Cells(8, 1) = "Gpt2Sur2"
End Sub
Maintenant ce qui serait bien de tester c'est avec les 2 Millions de lignes qui sont dans le désordres
et voir la rapidité des deux codes .
j'ai compléter votre fichier de 2 Millions de lignes en faisant des copier coller de ces 2 Millions de lignes a la suite jusqu'à ce que j'ai plus de mémoire pour le fichier texte
Résultat de mon code ci-dessus
pour 14 000 029 Lignes = 327 secondes
il faudrait créer un même fichier avec des codes aléatoires entre (G0001 et G450) soit Pour pour créer 14 000 000 / 500 = soit 28 000 fichiers csv
pour l exercice
Le service des pièces jointes, CJoint.com est un service de partage de fichier gratuit pour partager vos documents dans vos courriels, sur les forums ou dans vos petites annonces.
Par curiosité j'ai quand même dupliqué le fichier de 2 000 000 de lignes pour obtenir 14 000 000 de lignes, c'est très facile en VBA, le fichier pèse alors 1,94 Go !!!
La macro s'exécute sans problème en 262 secondes chez moi.
Edit : le tri du tableau de 14 000 000 d'éléments s'effectue en 105 secondes.
Vous pouvez générer le fichier de 14000000 de lignes et votre code.
CodFourAM = Aléatoire de CodFourAM (G0001 à G0500)
DateAppPrevAM = Aléatoire pour créer des dates entre "01/01/2004" et "01/06/2024" inclus les dates "01/01/2004" et "01/06/2024" dans la création
qu'elle est votre temps de traitement ?
VB:
Sub GenererFichierTexte()
Dim filePath As String
Dim fileNum As Integer
Dim i As Long
Dim CodFourAM As String
Dim DateAppPrevAM As String
Dim randDate As Date
Dim randIndex As Integer
Dim startDate As Date
Dim endDate As Date
Dim header As String
Dim lineContent As String
' Chemin et nom du fichier texte à créer
filePath = ThisWorkbook.Path & "\FournisseurData.txt"
fileNum = FreeFile
' Dates de début et de fin pour les dates aléatoires
startDate = DateValue("01/01/2004")
endDate = DateValue("01/06/2024")
' En-tête du fichier
header = "CodFourAM;NomFourAM;CodAM;CodArtRempAM;GenCod1AM;DesiAM;DesiFlouAM;DateAppPrevAM;PrixAchNetAM;PrixAchNetConvAM;PrixPubAM;PrixAchAM;CodTvaAM;UAchAM;UVteAM;QMC;CvStoVteAM;UStoAM;ST;CodDouaneAM;PoidsUAchAM en kg;EpaisAM en m;LargAM en m;LongAM en m;Diamètre en m;Volume en m3;CodClassAM;Remise1AM;Remise1ConvAM;Remise2AM;Remise2ConvAM;Remise3AM;Remise3ConvAM;Remise4AM;Remise4ConvAM;Remise5AM;Remise5ConvAM;CodEcoMobAM;CodEcoTaxeAM;NatureGazAM;QteGazAM;RTEXTE_FGAZ;SORECOP;NbUStoCondAchAM;NbUStoCondVteAM;CondAchAM;CondVteAM;TypeAM;Desi2AM;REP PMCB"
' Ouvrir le fichier pour écriture
Open filePath For Output As #fileNum
' Écrire l'en-tête dans le fichier
Print #fileNum, header
' Boucle pour générer 14 000 000 de lignes
For i = 1 To 14000000
' Générer un code aléatoire pour CodFourAM (G0001 à G0500)
randIndex = Int((500 - 1 + 1) * Rnd + 1)
CodFourAM = "G" & Format(randIndex, "0000")
' Générer une date aléatoire pour DateAppPrevAM entre startDate et endDate
randDate = DateSerial(Int((Year(endDate) - Year(startDate) + 1) * Rnd + Year(startDate)), _
Int((12 - 1 + 1) * Rnd + 1), _
Int((28 - 1 + 1) * Rnd + 1))
DateAppPrevAM = Format(randDate, "dd/mm/yyyy")
' Générer une ligne de contenu
lineContent = CodFourAM & ";HUOT01;9903.63SE1;;3607100049662A1;ROB1 9403 40/63SE F. A DROITE1;TT1;" & _
DateAppPrevAM & ";R1;Z1;317A1,00001;317V1,0000KJU1;20S1;EAU1;EAUYT1;OIU1;;EA;A1;B1;C1;D1;E1;F1;J1;K1;L1;M1;N1;O1;P1;Q1;R1;S1;T1;U1;V1;W1;X1;Y1;Z1;AA1;BB1;CC1;DD1;EE1;FF1;JJ1;HH1;"
' Écrire la ligne dans le fichier
Print #fileNum, lineContent
Next i
' Fermer le fichier
Close #fileNum
MsgBox "Fichier texte généré avec succès!"
End Sub
Vous pouvez générer le fichier de 14000000 de lignes et votre code.
CodFourAM = Aléatoire de CodFourAM (G0001 à G0500)
DateAppPrevAM = Aléatoire pour créer des dates entre "01/01/2004" et "01/06/2024" inclus les dates "01/01/2004" et "01/06/2024" dans la création
qu'elle est votre temps de traitement ?
VB:
Sub GenererFichierTexte()
Dim filePath As String
Dim fileNum As Integer
Dim i As Long
Dim CodFourAM As String
Dim DateAppPrevAM As String
Dim randDate As Date
Dim randIndex As Integer
Dim startDate As Date
Dim endDate As Date
Dim header As String
Dim lineContent As String
' Chemin et nom du fichier texte à créer
filePath = ThisWorkbook.Path & "\FournisseurData.txt"
fileNum = FreeFile
' Dates de début et de fin pour les dates aléatoires
startDate = DateValue("01/01/2004")
endDate = DateValue("01/06/2024")
' En-tête du fichier
header = "CodFourAM;NomFourAM;CodAM;CodArtRempAM;GenCod1AM;DesiAM;DesiFlouAM;DateAppPrevAM;PrixAchNetAM;PrixAchNetConvAM;PrixPubAM;PrixAchAM;CodTvaAM;UAchAM;UVteAM;QMC;CvStoVteAM;UStoAM;ST;CodDouaneAM;PoidsUAchAM en kg;EpaisAM en m;LargAM en m;LongAM en m;Diamètre en m;Volume en m3;CodClassAM;Remise1AM;Remise1ConvAM;Remise2AM;Remise2ConvAM;Remise3AM;Remise3ConvAM;Remise4AM;Remise4ConvAM;Remise5AM;Remise5ConvAM;CodEcoMobAM;CodEcoTaxeAM;NatureGazAM;QteGazAM;RTEXTE_FGAZ;SORECOP;NbUStoCondAchAM;NbUStoCondVteAM;CondAchAM;CondVteAM;TypeAM;Desi2AM;REP PMCB"
' Ouvrir le fichier pour écriture
Open filePath For Output As #fileNum
' Écrire l'en-tête dans le fichier
Print #fileNum, header
' Boucle pour générer 14 000 000 de lignes
For i = 1 To 14000000
' Générer un code aléatoire pour CodFourAM (G0001 à G0500)
randIndex = Int((500 - 1 + 1) * Rnd + 1)
CodFourAM = "G" & Format(randIndex, "0000")
' Générer une date aléatoire pour DateAppPrevAM entre startDate et endDate
randDate = DateSerial(Int((Year(endDate) - Year(startDate) + 1) * Rnd + Year(startDate)), _
Int((12 - 1 + 1) * Rnd + 1), _
Int((28 - 1 + 1) * Rnd + 1))
DateAppPrevAM = Format(randDate, "dd/mm/yyyy")
' Générer une ligne de contenu
lineContent = CodFourAM & ";HUOT01;9903.63SE1;;3607100049662A1;ROB1 9403 40/63SE F. A DROITE1;TT1;" & _
DateAppPrevAM & ";R1;Z1;317A1,00001;317V1,0000KJU1;20S1;EAU1;EAUYT1;OIU1;;EA;A1;B1;C1;D1;E1;F1;J1;K1;L1;M1;N1;O1;P1;Q1;R1;S1;T1;U1;V1;W1;X1;Y1;Z1;AA1;BB1;CC1;DD1;EE1;FF1;JJ1;HH1;"
' Écrire la ligne dans le fichier
Print #fileNum, lineContent
Next i
' Fermer le fichier
Close #fileNum
MsgBox "Fichier texte généré avec succès!"
End Sub
Bonjour, ce qui me gêne dans tous ces codes produits sur ce sujet : trop de valeurs en dur. Il faut passer absolument par un tableau structuré Excel dans lequel on va stocker ces paramètres - exemples
startDate = DateValue("01/01/2004")
endDate = DateValue("01/06/2024")
filePath = ThisWorkbook.Path & "\FournisseurData.txt" ==> le fichier DATA peut très bien se trouver dans un autre dossier que celui du classeur. C'est le cas généralement en mode production.
header = "CodFourAM;NomFourAM;CodAM;CodArtRempAM;GenCod1AM;DesiAM;DesiFlouAM;DateAppPrevAM;PrixAchNetAM;PrixAchNetConvAM;PrixPubAM;PrixAchAM;CodTvaAM;UAchAM;UVteAM;QMC;CvStoVteAM;UStoAM;ST;CodDouaneAM;PoidsUAchAM en kg;EpaisAM en m;LargAM en m;LongAM en m;Diamètre en m;Volume en m3;CodClassAM;Remise1AM;Remise1ConvAM;Remise2AM;Remise2ConvAM;Remise3AM;Remise3ConvAM;Remise4AM;Remise4ConvAM;Remise5AM;Remise5ConvAM;CodEcoMobAM;CodEcoTaxeAM;NatureGazAM;QteGazAM;RTEXTE_FGAZ;SORECOP;NbUStoCondAchAM;NbUStoCondVteAM;CondAchAM;CondVteAM;TypeAM;Desi2AM;REP PMCB"
' Boucle pour générer 14 000 000 de lignes
For i = 1 To 14000000
==> en dur et un avec un lof on peut déterminer le nombre de lignes en tenant compte des CR/LF (windows) ou issu de unix le LF seulement
etc. etc.
faire en sorte déjà que le VBA soit universel quelque-soit le fichier injecté. Là on arrive à du développement propriétaire et si par exemple l'une des colonnes devait changer de nom il faut intervenir dans le code.
Même si on maîtrise son sujet c'est toujours dangereux de réintervenir dans du code.
SI le tableau doit être industrialisé et "end-user" je vois mal un comptable par exemple non initié au VBA devoir intervenir. En revanche via un petit mode opératoire on lui explique comment paramétrer son classeur
Pour l'avoir dit, "le VBA c'est comme le poivre ou le piment en cuisine, bien utilisé ça ajoute de la saveur, mal utilisé votre plat est détruit ainsi que la fête"
Pour conclure j'ai été peut-être un peu rude mais c'est ma manière de lire les choes
Boucle pour générer 14 000 000 de lignes
For i = 1 To 14000000
==> en dur et un avec un lof on peut déterminer le nombre de lignes en tenant compte des CR/LF (windows) ou issu de unix le LF seulement
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.
