Optimiser Macro dans un fichier ayant plus de 50 000 lignes

Sub Inventory_postingList()
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim NL As Long 'déclare la variable NL (Nombre de lignes)
Dim I As Long 'déclare la variable I (Incrément de ligne)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim J As Long 'déclare la variable J (incrément de lignes)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Columns("A:B").Insert Shift:=x1ToRight 'insère deux colonnes à gauche
Range("A1").FormulaR1C1 = "#" 'écrit "#" en A1
Range("B1").FormulaR1C1 = "ITEM" 'écrit "ITEM" en B1
TC = Range("A1").CurrentRegion 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de lignes du tableau de cellule TC
For I = 2 To NL 'boucle sur toutes les lignes I du tableau de cellulles TC (en partant de la seconde)
    If TC(I, 3) = "" Or UCase(Right(TC(I, 3), 1)) = "U" Or TC(I, 8) > 0 Then 'condition 1 : si l'un des 3 cas
        ReDim Preserve TL(J) 'redimensionne le tableau de lignes TL
        TL(J) = I 'stocke dans TL(J) le numéro de ligne à effacer
        J = J + 1 'incrémente J
    Else 'sinon (condition 1)
        If TC(I, 4) = "" Then 'condition 2 : la valeur ligne I colonne 4 de TC est vide
            TC(I, 1) = TC(I, 3): TC(I, 3) = "" 'récupère en colonne 1 la valeur colonne 3 et efface la valeur colonne 3
            TC(I, 2) = TC(I, 7): TC(I, 7) = "" 'récupère en colonne 2 la valeur colonne 7 et efface la valeur colonne 7
        'condition 3 : si la valeur ligne I colonne 1 est vide et les deux premiers
        'caractères de la valeur ligne I colonne  'sont différents de "DN"
        ElseIf TC(I, 1) = "" And Left(TC(I, 4), 2) <> "DN" Then
            ReDim Preserve TL(J) 'redimensionne le tableau de lignes TL
            TL(J) = I 'stocke dans TL(J) le numéro de ligne à effacer
            J = J + 1 'incrémente J
        ElseIf TC(I, 1).Value = "" Then 'condition 4 : si la valeur ligne I colonne 1 est vide
            TC(I, 1) = TC(I - 1, 1) 'récupère en colonne 1 la valeur de la ligne au-dessus
            TC(I, 2) = TC(I - 1, 2) 'récupère en colonne 2 la valeur de la ligne au-dessus
        End If 'fin des condition 2, 3 et 4
    End If 'fin de la condition 1
Next I 'prochaine ligne du tableau de cellues TC
Range("A1").Resize(UBound(TC, 1), UBound(TC, 2)) = TC 'renvoie dans A1 le tableau TC moditfié
For I = UBound(TL) To LBound(TL) Step -1 'boucle inversée du dernièr élément tu tableau de ligne Tl au premier
    Rows(TL(I)).Delete 'supprime la ligne TL(I)
Next I 'prochaine élément de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

• Source => le chemin vers le fichier txt (complet, avec le répertoire + le nom du fichier + l'extension)
• Feuille => le nom de la feuille ou restituer les données.

Option Explicit

'========================================================================= Constantes A ADAPTER
Private Const Source As String = "C:\Users\....\Desktop\DONNEES_2.txt"   'chemin d'accès complet au fichier txt
Private Const Feuille As String = "Feuil3" 'nom de la feuille de restitution des données

'constante pour l'entête de la feuille de restitution
Private Const Entete As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
'Variable utilisée dans la Sub et dans la Function
Private delim As String

Sub Macfly()
Dim Tb() As String, Tb_Out() As Variant, Chaine As String, num As Long, i As Long

   '========================================================================= Initialisation des variables
   delim = Chr(9)    'délimiteur du fichier txt Chr(9) = Tabulation
   For i = 1 To 9
      Chaine = Chaine & delim 'Chaine pour éviter d'extraire les lignes vides du fichier txt
   Next i
   num = FreeFile    'Numéro libre d'ouverture d'un fichier
   
   '========================================================================= IMPORT du fixhier txt dans variable tableau (Tb)
   Open Source For Input As #num
   i = -1
   While Not EOF(1)
      i = i + 1
      ReDim Preserve Tb(i)
      Line Input #1, Tb(i)
      If Tb(i) = Chaine Then i = i - 1 'En évitant les lignes vides
   Wend
   Close #num
   '========================================================================= Organisation des données de la variable tableau Tb
   Tb_Out = Organise_Datas(Tb())
   
   '========================================================================= Restitution des données dans la feuille
   Application.ScreenUpdating = False 'désactive le rafraichissement d'écran
   With Sheets(Feuille)
      .Columns("A:K").ClearContents       'vide le contenu déjà présent
      .Columns("A:I").NumberFormat = "@"  'formate les colonnes A:I en texte
      '--------------------------------------------------------------------- Cellule K101 (formatage colonne K) A ADAPTER
      '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
      .Columns("K:K").NumberFormat = "General" 'formate la colonne K en standard ===> Affichage 2058
      For i = 1 To 11
         .Cells(1, i) = Split(Entete, ";")(i - 1) 'Ecris l'entête de la feuille
      Next
      .Cells(2, 1).Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out 'Saisie des données
      .Select
   End With
   Application.ScreenUpdating = True 'Active le rafraichissement d'écran

End Sub

Private Function Organise_Datas(Tb() As String) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   'on redimensionne le tableau TbTemp pour :
      '- transposer les données de Tb
      '- ajouter les deux premières colonnes
   ReDim Preserve TbTemp(1 To UBound(Tb), 1 To 11)
   'Boucle sur toutes les lignes extraites
   For i = 1 To UBound(Tb)
      'utilisation de Split avec le délimiteur pour "isoler" chacune des données
      'tests généraux sur :
         '- 1ère colonne du fichier txt (Posting Date <> "" ou <> u)
         '- 6ème colonne du fichier txt (Qty <= 0)
      If Split(Tb(i), delim)(0) <> "" Or UCase(Right(Split(Tb(i), delim)(0), 1)) <> "U" Or Split(Tb(i), delim)(5) <= 0 Then
         Cpt = Cpt + 1
         'test si Document vide
         If Split(Tb(i), delim)(1) = "" Then
            TbTemp(Cpt, 1) = CStr(Split(Tb(i), delim)(0))
            TbTemp(Cpt, 2) = CStr(Split(Tb(i), delim)(4))
            On Error Resume Next 'la dernière ligne du fichier txt, n'a pas 9 colonnes
            TbTemp(Cpt, 11) = CStr(Split(Tb(i), delim)(8))
            On Error GoTo 0
         'test si Document commence par DN
         ElseIf Left(Split(Tb(i), delim)(1), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 0 To UBound(Split(Tb(i), delim)) - 1
               TbTemp(Cpt, j + 3) = CStr(Split(Tb(i), delim)(j))
            Next j
         End If
      End If
      'évite les lignes vides
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Organise_Datas = TbTemp
End Function

Option Explicit

Private Const SOURCE As String = "C:\Users\pijaku\Desktop\DONNEES_2.txt"
Private Const ENTETE As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String

Public Sub Macfly_SEQ()
Dim Tb() As String, Tb_Out() As Variant, Chaine As String, num As Long, i As Long
Dim t As Double
t = Timer

   delim = Chr(9)
   Feuille = "Feuil2"
   For i = 1 To 9
      Chaine = Chaine & delim
   Next i
   num = FreeFile
   Open SOURCE For Input As #num
   i = -1
   While Not EOF(1)
      i = i + 1
      ReDim Preserve Tb(i)
      Line Input #1, Tb(i)
      If Tb(i) = Chaine Then i = i - 1
   Wend
   Close #num
   Tb_Out = Tri_Donnees_SEQ(Tb())
   Application.ScreenUpdating = False
   With Sheets(Feuille)
      .Columns("A:K").ClearContents
      .Columns("A:I").NumberFormat = "@"
      '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
      .Columns("K:K").NumberFormat = "General"
      For i = 1 To 11
         .Cells(1, i) = Split(ENTETE, ";")(i - 1)
      Next
      .Cells(2, 1).Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out
      .Select
   End With
   Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Private Function Tri_Donnees_SEQ(Tb() As String) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb), 1 To 11)
   For i = 1 To UBound(Tb)
      If Split(Tb(i), delim)(0) <> "" Or UCase(Right(Split(Tb(i), delim)(0), 1)) <> "U" Or Split(Tb(i), delim)(5) <= 0 Then
         Cpt = Cpt + 1
         If Split(Tb(i), delim)(1) = "" Then
            TbTemp(Cpt, 1) = CStr(Split(Tb(i), delim)(0))
            TbTemp(Cpt, 2) = CStr(Split(Tb(i), delim)(4))
            For j = 3 To UBound(Split(Tb(i), delim)) - 1
               If j <> 4 Then TbTemp(Cpt, j + 3) = CStr(Split(Tb(i), delim)(j))
            Next j
         ElseIf Left(Split(Tb(i), delim)(1), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 0 To UBound(Split(Tb(i), delim)) - 1
               TbTemp(Cpt, j + 3) = CStr(Split(Tb(i), delim)(j))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_SEQ = TbTemp
End Function

Option Explicit

Private Const SOURCE As String = "C:\Users\pijaku\Desktop\DONNEES_2.txt"
Private Const ENTETE As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String

Public Sub MacFly_FSO()
Dim oFso As Variant, txtFic As Variant, Tb As Variant, TbTemp() As Variant
Dim i As Long, j As Long, ligEnt As Byte
Dim t As Double
t = Timer
   
   delim = Chr(9)
   Feuille = "Feuil3"
   Set oFso = CreateObject("Scripting.FileSystemObject")
   Set txtFic = oFso.OpenTextFile(SOURCE)
   Do While Not txtFic.AtEndOfStream
      i = i + 1
      ReDim Preserve TbTemp(i)
      TbTemp(i) = Split(txtFic.ReadLine, delim)
      If j < UBound(TbTemp(i), 1) Then j = UBound(TbTemp(i), 1)
   Loop
   txtFic.Close
   ReDim Tb(1 To i, 1 To j + 1) As Variant
   For i = 1 To i
      For j = 0 To UBound(TbTemp(i), 1)
         Tb(i, j + 1) = TbTemp(i)(j)
      Next j
   Next i
   Tb = Tri_Donnees_FSO(Tb)
   Application.ScreenUpdating = False
   With Sheets(Feuille)
       .Columns("A:K").ClearContents
       .Columns("A:I").NumberFormat = "@"
       '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
       .Columns("K:K").NumberFormat = "General"
       For ligEnt = 1 To 11
          .Cells(1, ligEnt) = Split(ENTETE, ";")(ligEnt - 1)
       Next
       .Cells(2, 1).Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb
       .Select
    End With
    Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Private Function Tri_Donnees_FSO(Tb As Variant) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb, 1), 1 To UBound(Tb, 2) + 2)
   For i = 1 To UBound(Tb, 1)
      If Tb(i, 1) <> "" Or UCase(Right(Tb(i, 1), 1)) <> "U" Or Tb(i, 6) <= 0 Then
         Cpt = Cpt + 1
         If Tb(i, 2) = "" Then
            TbTemp(Cpt, 1) = CStr(Tb(i, 1))
            TbTemp(Cpt, 2) = CStr(Tb(i, 5))
            For j = 3 To UBound(Tb, 2) - 1
               If j <> 5 Then TbTemp(Cpt, j + 2) = CStr(Tb(i, j))
            Next j
         ElseIf Left(Tb(i, 2), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 1 To UBound(Tb, 2) - 1
               TbTemp(Cpt, j + 2) = CStr(Tb(i, j))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_FSO = TbTemp
End Function

Option Explicit

Private Const ENTETE As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String

Sub MacFly_JET()
Const REPERTOIRE As String = "C:\Users\pijaku\Desktop"
Const FICHIER As String = "DONNEES_2.txt"
Dim strReq As String
Dim Conn As ADODB.Connection, Enrg As ADODB.Recordset
Dim Extract As Variant, Tb() As String, Temp As Variant, i As Long, j As Integer
Dim t As Double
t = Timer

   strReq = "SELECT * FROM " & FICHIER
   Feuille = "Feuil4"
   delim = Chr(9)
   Set Conn = New ADODB.Connection
   On Error Resume Next
   Conn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & "Dbq=" & REPERTOIRE & ";" & "Extensions=txt;"
   On Error GoTo 0
   If Conn.State <> 1 Then Exit Sub
   Set Enrg = New ADODB.Recordset
   On Error Resume Next
   Enrg.Open strReq, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
   On Error GoTo 0
   If Enrg.State <> 1 Then
       Conn.Close
       Set Conn = Nothing
       Exit Sub
   End If
   Extract = Enrg.GetRows
   ReDim Preserve Tb(0 To UBound(Extract, 2), 0 To 9)
   For i = 0 To UBound(Extract, 2)
      If Extract(0, i) & Extract(1, i) <> "" Then
         For j = 0 To UBound(Split(Extract(0, i) & Extract(1, i), delim))
            Tb(i, j) = Split(Extract(0, i) & Extract(1, i), delim)(j)
         Next j
      End If
   Next i
   Enrg.Close
   Conn.Close
   Set Enrg = Nothing
   Set Conn = Nothing
   Temp = Tri_Donnees_JET(Tb)
   Application.ScreenUpdating = False
   With Sheets(Feuille)
       .Columns("A:K").ClearContents
       .Columns("A:I").NumberFormat = "@"
       '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
       .Columns("K:K").NumberFormat = "General"
       For i = 1 To 11
          .Cells(1, i) = Split(ENTETE, ";")(i - 1)
       Next
       .Cells(2, 1).Resize(UBound(Temp, 1), UBound(Temp, 2)) = Temp
       .Select
    End With
    Application.ScreenUpdating = True
   MsgBox Timer - t
End Sub

Private Function Tri_Donnees_JET(Tb As Variant) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb, 1), 1 To UBound(Tb, 2) + 2)
   For i = 0 To UBound(Tb, 1)
      If Tb(i, 0) <> "" Or UCase(Right(Tb(i, 0), 1)) <> "U" Or Tb(i, 5) <= 0 Then
         Cpt = Cpt + 1
         If Tb(i, 1) = "" Then
            If Tb(i, 0) <> "" And Tb(i, 4) <> "" Then
               TbTemp(Cpt, 1) = CStr(Tb(i, 0))
               TbTemp(Cpt, 2) = CStr(Tb(i, 4))
               For j = 3 To UBound(Tb, 2) - 1
                  If j <> 4 Then TbTemp(Cpt, j + 3) = CStr(Tb(i, j))
               Next j
            End If
         ElseIf Left(Tb(i, 1), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 1 To UBound(Tb, 2)
               TbTemp(Cpt, j + 2) = CStr(Tb(i, j - 1))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Or TbTemp(Cpt, 2) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_JET = TbTemp
End Function

Option Explicit

Private Const ENTETE As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String

'=====================================================
'Méthode 1 => Lecture séquentielle du fichier txt
Public Sub Macfly_SEQ()
Dim Tb() As String, Tb_Out() As Variant, Chaine As String, NomFic As String, num As Long, i As Long
Dim t As Double
t = Timer

   delim = Chr(9)
   Feuille = "Feuil2"
   For i = 1 To 9
      Chaine = Chaine & delim
   Next i
   num = FreeFile
   NomFic = Source
   Open NomFic For Input As #num
   i = -1
   While Not EOF(1)
      i = i + 1
      ReDim Preserve Tb(i)
      Line Input #1, Tb(i)
      If Tb(i) = Chaine Then i = i - 1
   Wend
   Close #num
   Tb_Out = Tri_Donnees_SEQ(Tb())
   Application.ScreenUpdating = False
   With Sheets(Feuille)
      .Columns("A:K").ClearContents
      .Columns("A:I").NumberFormat = "@"
      '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
      .Columns("K:K").NumberFormat = "General"
      For i = 1 To 11
         .Cells(1, i) = Split(ENTETE, ";")(i - 1)
      Next
      .Cells(2, 1).Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out
      .Select
   End With
   Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Private Function Tri_Donnees_SEQ(Tb() As String) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb), 1 To 11)
   For i = 1 To UBound(Tb)
      If Split(Tb(i), delim)(0) <> "" Or UCase(Right(Split(Tb(i), delim)(0), 1)) <> "U" Or Split(Tb(i), delim)(5) <= 0 Then
         Cpt = Cpt + 1
         If Split(Tb(i), delim)(1) = "" Then
            TbTemp(Cpt, 1) = CStr(Split(Tb(i), delim)(0))
            TbTemp(Cpt, 2) = CStr(Split(Tb(i), delim)(4))
            For j = 3 To UBound(Split(Tb(i), delim)) - 1
               If j <> 4 Then TbTemp(Cpt, j + 3) = CStr(Split(Tb(i), delim)(j))
            Next j
         ElseIf Left(Split(Tb(i), delim)(1), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 0 To UBound(Split(Tb(i), delim)) - 1
               TbTemp(Cpt, j + 3) = CStr(Split(Tb(i), delim)(j))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_SEQ = TbTemp
End Function
Private Function Source() As String
Source = Application.GetOpenFilename
End Function

Option Explicit

Private Const ENTETE As String = "#;ITEM;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String
'=====================================================
'Méthode 2 => Utilisation du FSO (FileSystemObject) pour la lecture du fichier txt
Public Sub MacFly_FSO()
Dim oFso As Variant, txtFic As Variant, Tb As Variant, TbTemp() As Variant
Dim i As Long, j As Long, ligEnt As Byte, NomFic As String
Dim t As Double
t = Timer
   
   delim = Chr(9)
   Feuille = "Feuil3"
   NomFic = Source
   Set oFso = CreateObject("Scripting.FileSystemObject")
   Set txtFic = oFso.OpenTextFile(NomFic)
   Do While Not txtFic.AtEndOfStream
      i = i + 1
      ReDim Preserve TbTemp(i)
      TbTemp(i) = Split(txtFic.ReadLine, delim)
      If j < UBound(TbTemp(i), 1) Then j = UBound(TbTemp(i), 1)
   Loop
   txtFic.Close
   ReDim Tb(1 To i, 1 To j + 1) As Variant
   For i = 1 To i
      For j = 0 To UBound(TbTemp(i), 1)
         Tb(i, j + 1) = TbTemp(i)(j)
      Next j
   Next i
   Tb = Tri_Donnees_FSO(Tb)
   Application.ScreenUpdating = False
   With Sheets(Feuille)
       .Columns("A:K").ClearContents
       .Columns("A:I").NumberFormat = "@"
       '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
       .Columns("K:K").NumberFormat = "General"
       For ligEnt = 1 To 11
          .Cells(1, ligEnt) = Split(ENTETE, ";")(ligEnt - 1)
       Next
       .Cells(2, 1).Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb
       .Select
    End With
    Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Private Function Tri_Donnees_FSO(Tb As Variant) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb, 1), 1 To UBound(Tb, 2) + 2)
   For i = 1 To UBound(Tb, 1)
      If Tb(i, 1) <> "" Or UCase(Right(Tb(i, 1), 1)) <> "U" Or Tb(i, 6) <= 0 Then
         Cpt = Cpt + 1
         If Tb(i, 2) = "" Then
            TbTemp(Cpt, 1) = CStr(Tb(i, 1))
            TbTemp(Cpt, 2) = CStr(Tb(i, 5))
            For j = 3 To UBound(Tb, 2) - 1
               If j <> 5 Then TbTemp(Cpt, j + 2) = CStr(Tb(i, j))
            Next j
         ElseIf Left(Tb(i, 2), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            For j = 1 To UBound(Tb, 2) - 1
               TbTemp(Cpt, j + 2) = CStr(Tb(i, j))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_FSO = TbTemp
End Function

Private Function Source() As String
Source = Application.GetOpenFilename
End Function

Option Explicit

Private Const ENTETE As String = "#;ITEM;???;N° SEM;Year;Posting Date;Document;Whse;G/L Acct/BP Code;G/L Acct/BP Name;Qty;Inventory UoM;Price after Disc.;Balance"
Private delim As String
Private Feuille As String

'=====================================================
'Méthode 1 => Lecture séquentielle du fichier txt
Public Sub Macfly_SEQ()
Dim Tb() As String, Tb_Out() As Variant, Chaine As String, NomFic As String, num As Long, i As Long
Dim t As Double
t = Timer

   delim = Chr(9)
   Feuille = "Feuil2"
   For i = 1 To 9
      Chaine = Chaine & delim
   Next i
   num = FreeFile
   NomFic = Source
   If NomFic = "" Then Exit Sub
   Open NomFic For Input As #num
   i = -1
   While Not EOF(1)
      i = i + 1
      ReDim Preserve Tb(i)
      Line Input #1, Tb(i)
      If Tb(i) = Chaine Then i = i - 1
   Wend
   Close #num
   Tb_Out = Tri_Donnees_SEQ(Tb())
   Application.ScreenUpdating = False
With Sheets(Feuille)
      .Columns("A:K").ClearContents
      .Columns("A:G").NumberFormat = "@"
      .Columns("H:H").NumberFormat = "0.00"
      .Columns("I:I").NumberFormat = "@"
      '.Columns("K:K").NumberFormat = "@"  'formate la colonne K en texte ===> Affichage 2,058
      .Columns("K:K").NumberFormat = "General"
      For i = 0 To UBound(Split(ENTETE, ";"))
         .Cells(1, i + 1) = Split(ENTETE, ";")(i)
      Next
      .Cells(2, 1).Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out
      .Select
   End With
   Application.ScreenUpdating = True
MsgBox Timer - t
End Sub

Private Function Tri_Donnees_SEQ(Tb() As String) As Variant()
Dim TbTemp() As Variant, i As Long, Cpt As Long, j As Byte

   ReDim Preserve TbTemp(1 To UBound(Tb), 1 To 14)
   For i = 1 To UBound(Tb)
      If Split(Tb(i), delim)(0) <> "" Or UCase(Right(Split(Tb(i), delim)(0), 1)) <> "U" Or Split(Tb(i), delim)(5) <= 0 Then
         Cpt = Cpt + 1
         If Split(Tb(i), delim)(1) = "" Then
            TbTemp(Cpt, 1) = CStr(Split(Tb(i), delim)(0))
            TbTemp(Cpt, 2) = CStr(Split(Tb(i), delim)(4))
            For j = 3 To UBound(Split(Tb(i), delim)) - 1
               If j = 3 And IsDate(Split(Tb(i), delim)(j)) Then TbTemp(Cpt, 4) = num_sem(CDate(Split(Tb(i), delim)(j)))
               If j = 4 And IsDate(Split(Tb(i), delim)(j)) Then TbTemp(Cpt, 4) = Year(Split(Tb(i), delim)(j))
               If j <> 4 Then TbTemp(Cpt, j + 6) = CStr(Split(Tb(i), delim)(j))
            Next j
         ElseIf Left(Split(Tb(i), delim)(1), 2) = "DN" Then
            TbTemp(Cpt, 1) = CStr(TbTemp(Cpt - 1, 1))
            TbTemp(Cpt, 2) = CStr(TbTemp(Cpt - 1, 2))
            If IsDate(Split(Tb(i), delim)(0)) Then
               TbTemp(Cpt, 4) = num_sem(CDate(Split(Tb(i), delim)(0)))
               TbTemp(Cpt, 5) = Year(Split(Tb(i), delim)(0))
            End If
            For j = 0 To UBound(Split(Tb(i), delim)) - 1
               TbTemp(Cpt, j + 6) = CStr(Split(Tb(i), delim)(j))
            Next j
         End If
      End If
      If TbTemp(Cpt, 1) = "" Then Cpt = Cpt - 1
   Next i
   Tri_Donnees_SEQ = TbTemp
End Function
Private Function Source() As String
Source = Application.GetOpenFilename
End Function
Private Function num_sem(D As Date) As Long
   'Auteur: Laurent Longre. X-Cell
   'La fonction suivante renvoie le numéro de semaine conforme à la norme ISO, _
   utilisée dans les pays européens (la première semaine d'un mois étant définie _
   comme la première semaine comportant au moins quatre jours dans le mois).
   D = Int(D)
   num_sem = DateSerial(Year(D + (8 - Weekday(D)) Mod 7 - 3), 1, 1)
   num_sem = ((D - num_sem - 3 + (Weekday(num_sem) + 1) Mod 7)) \ 7 + 1
End Function