XL 2019 Fichier ".txt" de plus de 2.000.000 de lignes !

Titof06

XLDnaute Junior
Bonjour,

J'ai à traiter un fichier texte de plus de 2.000.000 de lignes.

Excel n'accepte qu'environ 1.500.000 lignes.

Je dois extraire des informations relatives à des mises à jour de fournisseurs et par rapport à une date précise.

Est-ce que quelqu'un pourrait me conseiller un logiciel ou une façon de sortir des informations de ce méga fichier texte, svp ?

Par avance, Merci 👍

Bonne Journée, Titof06 :)
 

job75

XLDnaute Barbatruc
Bonjour Titof06, le forum,

Pour réduire la recherche et gagner du temps j'utilise ici la fonction VBA Filter :
VB:
Sub Creer_feuilles_fournisseurs()
Dim datedeb As Date, datefin As Date, coldate%, chemin$, fournisseurs$, fichier$, w As Worksheet
Dim Source, n%, d As Object, x%, tablo, ub&, i&, s, dat$, code$, filtre, j&, nomfeuille$, wb As Workbook
datedeb = DateValue("01/03/2024") 'à adapter
'datedeb = DateValue("01/03/2022") 'pour récupérer toutes les dates
datefin = Date 'date du jour
coldate = 8 'numéro de colonne à adapter
chemin = ThisWorkbook.Path & "\"
fournisseurs = chemin & "Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs 'crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
'---vide le sous-dossier---
While fichier <> ""
    Kill fournisseurs & fichier
    fichier = Dir
Wend
'---supprime les feuillea---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
    If UCase(w.Name) <> "ACCUEIL" Then w.Delete
Next w
'---création des fichiers et feuilles fournisseurs---
Source = Array("famrem_sacha_Pour Test.txt", "hzn_sacha_Pour Test.txt") 'à adapter
For n = 0 To UBound(Source)
    Set d = CreateObject("Scripting.Dictionary")
    x = FreeFile
    Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
    tablo = Split(Input(LOF(x), #x), vbCrLf)
    ub = UBound(tablo)
    Close #x
    '---création des fichiers---
    For i = 1 To ub
        s = Split(tablo(i), ";", coldate + 1)
        If UBound(s) + 2 > coldate Then
            dat = s(coldate - 1)
            If IsDate(dat) Then
                If CDate(dat) >= datedeb And CDate(dat) <= datefin Then
                    code = s(0) 'code fournisseur
                    If Not d.exists(code) Then
                        d(code) = ""
                        filtre = Filter(tablo, code) 'filtre pour réduire la recherche
                        fichier = fournisseurs & "F" & Format(n + 1, "00") & code & ".csv"
                        x = FreeFile
                        Open fichier For Output As #x 'ouverture en écriture séquentielle
                        Print #x, tablo(0)
                        For j = 0 To UBound(filtre)
                            s = Split(filtre(j), ";", coldate + 1)
                            If UBound(s) + 2 > coldate Then
                                If s(0) = code Then
                                    dat = s(coldate - 1)
                                    If IsDate(dat) Then If CDate(dat) >= datedeb And CDate(dat) <= datefin Then Print #x, filtre(j)
                                End If
                            End If
                        Next j
                        Close #x
                    End If
                End If
            End If
        End If
    Next i
    '---création des feuilles---
    If d.Count Then
        tablo = d.keys
        For i = 0 To UBound(tablo)
            nomfeuille = "F" & Format(n + 1, "00") & tablo(i)
            fichier = fournisseurs & nomfeuille & ".csv"
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = nomfeuille
           With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ActiveSheet.Cells(1))
                .TextFilePlatform = 65001 'origine UTF-8
                .TextFileParseType = xlDelimited
                .TextFileSemicolonDelimiter = True
                .Refresh
                .Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
                .Delete 'supprime la requête
            End With
        Next i
    End If
Next n
Sheets(1).Activate
End Sub
Pour la création des feuilles j'utilise de nouveau QueryTables, c'est plus rapide avec 200 feuilles :
- création des 200 fichiers CSV => 72 secondes

- création des 200 feuilles => 118 secondes.

A+
 

Pièces jointes

  • Créer feuilles fournisseurs.xlsm
    27.5 KB · Affichages: 2
  • famrem_sacha_Pour Test.txt
    586 bytes · Affichages: 2
  • hzn_sacha_Pour Test.txt
    1.4 KB · Affichages: 2

job75

XLDnaute Barbatruc
Bien entendu il n'est pas indispensable de créer des feuilles, on peut se contenter d'une liste :
VB:
Sub Creer_feuilles_fournisseurs()
Dim datedeb As Date, datefin As Date, coldate%, chemin$, fournisseurs$, fichier$
Dim Source, n%, d As Object, x%, tablo, i&, s, dat$, code$, liste(), nn&, filtre, j&
datedeb = DateValue("01/03/2024") 'à adapter
'datedeb = DateValue("01/03/2022") 'pour récupérer toutes les dates
datefin = Date 'date du jour
coldate = 8 'numéro de colonne à adapter
chemin = ThisWorkbook.Path & "\"
fournisseurs = chemin & "Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs 'crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
'---vide le sous-dossier---
While fichier <> ""
    Kill fournisseurs & fichier
    fichier = Dir
Wend
'---création des fichierse---
Source = Array("famrem_sacha_Pour Test.txt", "hzn_sacha_Pour Test.txt") 'à adapter
For n = 0 To UBound(Source)
    Set d = CreateObject("Scripting.Dictionary")
    x = FreeFile
    Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
    tablo = Split(Input(LOF(x), #x), vbCrLf)
    Close #x
    For i = 1 To UBound(tablo)
        s = Split(tablo(i), ";", coldate + 1)
        If UBound(s) + 2 > coldate Then
            dat = s(coldate - 1)
            If IsDate(dat) Then
                If CDate(dat) >= datedeb And CDate(dat) <= datefin Then
                    code = s(0) 'code fournisseur
                    If Not d.exists(code) Then
                        d(code) = ""
                        ReDim Preserve liste(nn)
                        liste(nn) = "F" & Format(n + 1, "00") & code
                        nn = nn + 1
                        filtre = Filter(tablo, code) 'filtre pour réduire la recherche
                        fichier = fournisseurs & "F" & Format(n + 1, "00") & code & ".csv"
                        x = FreeFile
                        Open fichier For Output As #x 'ouverture en écriture séquentielle
                        Print #x, tablo(0)
                        For j = 0 To UBound(filtre)
                            s = Split(filtre(j), ";", coldate + 1)
                            If UBound(s) + 2 > coldate Then
                                If s(0) = code Then
                                    dat = s(coldate - 1)
                                    If IsDate(dat) Then If CDate(dat) >= datedeb And CDate(dat) <= datefin Then Print #x, filtre(j)
                                End If
                            End If
                        Next j
                        Close #x
                    End If
                End If
            End If
        End If
Next i, n
'---création de la liste---
Range("A2:A" & Rows.Count).ClearContents
[D9] = ""
If nn Then [A2].Resize(nn) = Application.Transpose(liste)
End Sub
Les fichiers CSV seront ouverts par cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$9" Or Target(1) = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open(ThisWorkbook.Path & "\Fournisseurs\" & Target & ".csv", Local:=True).Sheets(1).Columns.AutoFit
End Sub
 

Pièces jointes

  • Créer feuilles fournisseurs.xlsm
    28.6 KB · Affichages: 2
  • famrem_sacha_Pour Test.txt
    586 bytes · Affichages: 4
  • hzn_sacha_Pour Test.txt
    1.4 KB · Affichages: 5

laurent950

XLDnaute Barbatruc
Bonjour @oguruma
Hello, ok ça marche je reviens vers toi dès que j'ai un peu de temps pour te faire ce montage avec un fichier avec moins de volumétrie pour des raisons pratiques.

J'ai construit le code, je vais l'optimiser à présent des que j'ai les règles données d entrées et données sorties pour être en phase avec vous. J'ai bien envie de tester nos deux méthodes différentes pour un même résultats obtenu.
 

oguruma

XLDnaute Occasionnel
Bonjour laurent950, le forum;

Utilisez donc le fichier Fichier2000000.txt déposé sur cjoint.com au post #48.

A+
Bonsoir, en voici un d'un autre genre afin de varier les tests, les données sont publiques, j'ai répété les lignes pour avoir les 2000 000
 

oguruma

XLDnaute Occasionnel
Bonsoir, en voici un d'un autre genre afin de varier les tests, les données sont publiques, j'ai répété les lignes pour avoir les 2000 000
Je vais également le tester avec ma solution
 

Cousinhub

XLDnaute Barbatruc
Inactif
Bonsoir, en voici un d'un autre genre afin de varier les tests, les données sont publiques, j'ai répété les lignes pour avoir les 2000 000
Hello,
J'ai ce message d'avertissement lorsque je veux télécharger via le lien fourni...
1718688444093.png

Bonne journée
 

oguruma

XLDnaute Occasionnel
Hello,
J'ai ce message d'avertissement lorsque je veux télécharger via le lien fourni...
Regarde la pièce jointe 1199043
Bonne journée
Bonjour CousinHub, je viens de le faire à l'instant je n'ai pas eu ce message.... ton antivirus doit être assez sensible je présume..
Attendons les retours des autres.....

1718694721202.png

1718694768689.png


1718694832065.png


1718694866920.png


1718695101961.png


Succès avec deux essais comme tu peux le voir dans ces images écran
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour CousinHub, je viens de le faire à l'instant je n'ai pas eu ce message.... ton antivirus doit être assez sensible je présume..
Attendons les retours des autres.....
Hi,
Le seul AV, c'est Windows Defender
Et j'utilise FireFox...
Par contre, avec Chrome, pas de soucis...
J'ai un tout petit peu regardé les données, et je ne vois pas de champ "Date"
Or il me semble (j'ai lu en diagonale le roman) que l'objet de la question est une recherche de différence de prix entre 2 dates...
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Avec un tri préalable par Quick sort du tableau source c'est nettement plus rapide :
VB:
Sub Creer_fichiers_fournisseurs()
Dim datedeb As Date, datefin As Date, coldate%, chemin$, fournisseurs$, fichier$
Dim Source, n%, x%, tablo, ub&, i&, s, dat As Variant, code$, liste(), nn&, txt$, j&
datedeb = CDate("01/03/2024") 'à adapter
'datedeb = CDate("01/03/2022") 'pour récupérer toutes les dates
datefin = Date 'date du jour
coldate = 8 'numéro de colonne à adapter
chemin = ThisWorkbook.Path & "\"
fournisseurs = chemin & "Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs 'crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
'---vide le sous-dossier---
While fichier <> ""
    Kill fournisseurs & fichier
    fichier = Dir
Wend
'---création des fichierse---
Source = Array("famrem_sacha_Pour Test.txt", "hzn_sacha_Pour Test.txt") 'à adapter
For n = 0 To UBound(Source)
    x = FreeFile
    Open chemin & Source(n) For Input As #x 'ouverture en lecture séquentielle
    tablo = Split(Input(LOF(x), #x), vbCrLf)
    ub = UBound(tablo)
    Close #x
    tri tablo, 1, ub - 1 'tri préalable par Quick sort
    For i = 1 To ub
        s = Split(tablo(i), ";", coldate + 1)
        If UBound(s) + 2 > coldate Then
            dat = s(coldate - 1)
            If IsDate(dat) Then
                dat = CDate(dat)
                If dat >= datedeb And dat <= datefin Then
                    code = s(0) 'code fournisseur
                    ReDim Preserve liste(nn)
                    liste(nn) = "F" & Format(n + 1, "00") & code
                    nn = nn + 1
                    fichier = fournisseurs & "F" & Format(n + 1, "00") & code & ".csv"
                    x = FreeFile
                    Open fichier For Output As #x 'ouverture en écriture séquentielle
                    Print #x, tablo(0) 'titres
                    Print #x, tablo(i)
                    txt = code & ";*"
                    For j = i + 1 To ub
                        If Not tablo(j) Like txt Then Exit For
                        s = Split(tablo(j), ";", coldate + 1)
                        If UBound(s) + 2 > coldate Then
                            dat = s(coldate - 1)
                            If IsDate(dat) Then dat = CDate(dat): If dat >= datedeb And dat <= datefin Then Print #x, tablo(j)
                        End If
                    Next j
                    Close #x
                    i = j - 1
                End If
            End If
        End If
Next i, n
'---remplissage de la ComboBox---
If nn = 0 Then Exit Sub
With ActiveSheet.ComboBox1
    .Activate
    .Text = ""
    .List = liste
    .DropDown 'déroule la liste
End With
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Sur 2 000 000 de lignes on en est chez moi à 50 secondes.

Edit : ajouté i = j - 1 ce qui réduit la durée à 39 secondes :
Notez qu'avec cette instruction le Dictionary n'est plus nécessaire.

A+
 

Pièces jointes

  • Créer fichiers fournisseurs.xlsm
    34.6 KB · Affichages: 2
  • famrem_sacha_Pour Test.txt
    586 bytes · Affichages: 2
  • hzn_sacha_Pour Test.txt
    1.4 KB · Affichages: 2
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour Cousinhub,

Dans ce qu'a dit Titof06 je ne vois pas une telle demande.

Ce qu'il a demandé c'est de filtrer le tableau source entre 2 dates.

A+
Hello,
Comme je l'ai dit, je n'ai qu'entre-lu le roman...
Et me suis arrêté à la question originelle
---
Je dois extraire des informations relatives à des mises à jour de fournisseurs et par rapport à une date précise.
---
Mais il est fort possible que la demande ait évolué...(ou plus probablement, que je n'ai rien compris....)
Bonne apm
 

Discussions similaires

Statistiques des forums

Discussions
315 098
Messages
2 116 193
Membres
112 679
dernier inscrit
Yupanki