Optimiser Macro dans un fichier ayant plus de 50 000 lignes

Bonjour,

1) Quand on supprime des lignes, il est toujours bien plus rapide de commencer par la dernière :
For z = LNG to 2 Step -1

2) plutôt qu'un paste spécial valeur il est préférable d'utiliser simplement :
rngCible.Value = rngSource.Value

Bonsoir M@cfly,Patrice, bonsoir le forum,

Peut-être comme ça :

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

Au lieu de travailler directement dans les cellules j'utilise une variable tableau TC avec un accès beaucoup plus rapide. Ça devrait considérablement améliorer la vitesse d'exécution...
À plus,
ThauTheme

Bonjour M@cfly, Patrice, ThauTheme,

Tu dis : J'ai un rapport TXT que je dois reformater dans Excel afin de sortir des statistiques.

Et si, au lieu de créer une macro fonctionnant à postériori, tu te faisais, en même temps, une macro d'importation de ton fichier txt?

Pour l'instant, pour créer ta feuille de 125 000 lignes, je supposes que tu fais un copié-collé. On pourrait très bien importer le contenu de ton fichier txt dans une variable tableau et la traiter un peu à la manière de ThauTheme.

Tu dis...

Bonjour,

ça ne dérangera personne de t'aider, c'est le but du forum.
Par contre, il faudrait que tu nous précise réellement qu'elles sont tes conditions.
En partant de ton fichier txt, comment fais tu, manuellement pour obtenir ton résultat.
Tu copie ton fichier txt, le colle à partir de C2 etc...
Toutes les étapes doivent être décrites.

Bonjour,

Tout d'abord, une petite difficulté supplémentaire se présente à moi, ou plutôt une incompréhension :

La colonne K (Balance) de ton fichier RESULTAT_maMacro.xlsx contient des valeurs numériques à 4 chiffres (exemple ligne 101 : 2058) alors que dans le fichier DONNEES.txt, ces valeurs sont décimales : 2,058.
Que doit-on faire?

Ensuite, pour te parler performances, la macro sur laquelle je travaille, traite plus de 80 000 lignes initiales (un peu plus de 51 000 à l'arrivée) en moins de 7 secondes, y compris l'importation du fichier txt que tu n'auras plus à faire manuellement.
Mais bon, à la différence de ThauTheme (que je salue), mon pc est réellement performant (je suis au taf ;-)).

Bon...
La différence tiens dans le formatage préalable de la colonne K. Si on veut 2,058 en K101, il faut la formater en texte, pour obtenir 2058 il faut formater en standard. J'ai mis les deux dans la macro, il suffit de commenter (ou dé-commenter) la ligne correspondante.

A adapter :
En tout début de code, deux constantes sont à adapter :

• 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.

A vérifier : la variable delim. Selon la construction du fichier txt. Celui proposé dans les sources ici utilise la tabulation (Chr(9)) comme délimiteur. Changer donc cette variable si on utilise le point-virgule ou autre...

Performances : fichier txt de 82 399 lignes restitué en 51 921 lignes. Durée : 7,55 secondes.
Configuration pc : W7 + Excel 2010 en 32 bits
Processeur Celeron 1,80 Ghz
RAM : 4 Go

Le code :

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

Dans l'attente...

Re-

Voici trois des méthodes (il en existe d'autres) adaptées à ton problème.
Ne pas oublier d'adapter ce qui doit l'être : chemin d'accès + nom du fichier.

1- Méthode 1 => Lecture séquentielle du fichier txt
C'est celle décrite plus haut que tu ne parviens pas à faire fonctionner.
Je l'ai légèrement modifiée pour être sur de ne rien oublier.

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

2- Méthode 2 => Utilisation du FSO (FileSystemObject) pour la lecture du fichier txt
Si cela ne passe pas, retenter en cochant la référence "Microsoft Scripting Runtime". Pour info, chez moi ça passe sans...
(pour cocher une référence : sous VBE : OUtils/Références, chercher et cocher la référence demandée)

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

3- Méthode 3 => Utilisation du Jet de Microsoft pour l'import du fichier txt
!!!! Nécessite de cocher la référence Microsoft ActiveX DataObject 2.0
Cette méthode, curieusement, ne rapatrie pas toutes les données dans leur intégralité. Elle en tronque certaines et en oublie d'autres, je ne sais pas pourquoi. C'est pour cela que je la places ici tout de même; si un collègue arrivait à m'expliquer pourquoi...

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

En terme de performances, la 1 et la 2 sont identiques. La 3 est un peu plus lente (10 sec pour 100 000 lignes).
Vous trouverez, ci-joint, mon fichier de travail.
Dans la feuille Feuil1, des tests de comparaison entre les méthodes.

Bonjour le fil, bonjour le forum,

Merci Pijaku d'avoir pris le relai car je me suis absenté quelques jour et je suis un peu larguer là... C'est toujours un grand plaisir de te croiser au fil des fils...

Bonjour,

Oh comme ta réponse manque cruellement de précisions!

Le fichier de s'ouvre pas. Quel fichier?
Ton fichier txt?
==> Normal, on ne l'ouvre pas.
Mon fichier transmis précédemment?
==> Pas normal, il s'agit d'un simple fichier xlsm...

Serait-ce une question de sécurité?
Si tu parles de ton fichier txt, oui il peut y avoir un problème de sécurité.
Si tu parles de mon fichier, il faut regarder le niveau de sécurité des macros... et accepter les macros.

Pour les 2 propositions, tu as un souci avec le chemin d'accès au fichier txt. On va essayer de contourner ce problème par macro, en utilisant une boite de dialogue de sélection de fichier plutôt que de l'inscrire en dur.

Essaye ces deux possibilités (chacune dans son propre Module standard) :

Méthode 1 :

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

Méthode 2

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

Bonjour,

Avec un peu (beaucoup) de retard, essaye ce code :

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