Discussion :

[apt]

Bonsoir à tous,

Pour récupérer les lignes d'un fichier texte, j'utilise ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Sub OuvreFichL3()
    Dim B$(), bb$(4), Item As Object
    Dim i As Byte, LastLg As Long
    Dim Name As String
    Dim NC As Boolean
    Dim tabNC()
    Dim Ligne As Long
    Dim Start, EndStart
    Start = Timer
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    'On Error Resume Next
    reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If reponse = False Then Exit Sub
    Canal = FreeFile
    Open reponse For Input As #Canal
    [A1].Value = "Numéro"
 
    Range("A2:A" & [A65000].End(xlUp).Row + 1).ClearContents
    Range("A2:A" & [A65000].End(xlUp).Row + 1).Interior.Pattern = xlNone
    Do While Not EOF(Canal)
        Line Input #Canal, a$
 
        If Len(Trim(a$)) > 0 Then    '-- Si la ligne est non vide
 
            If InStr(1, a$, "ABN") > 0 Then
                '-- Lire une nouvelle ligne
                Line Input #Canal, a$
                ' Si la ligne contient la chaine WO en passe
                If InStr(1, a$, " WO") > 1 Then
                    Line Input #Canal, a$
                    Continue = True
                Else
                    Continue = True
                End If
 
                Do While Continue
                    Debug.Print a$
                    B$ = Split(Trim(a$), " ")
 
                    i = 0: j = 0
                    ' On parcours le tableau résultant
                    For Each Item In B$
                        ' Si l'élément du tableau est non vide
                        If Len(Trim(Item)) > 0 Then
                            If InStr(1, Item, "L3-") > 0 And _
                               InStr(1, Item, "&") = 0 Then
 
                                'Debug.Print Item
 
                                ' Si la ligne suivante contient la chaine CL
                                ' on ne comptabilise pas la l'élément en cours
                                Line Input #Canal, a$    'ICI on devra relire cette ligne si elle ne contient pas de CL ???
                                If InStr(1, a$, "CL") = 0 Then
                                    li = Split(Item, "-")
                                    '-- Ecriture dans le feuille
                                    LastLg = [A65000].End(xlUp).Row + 1
                                    Cells(LastLg, 1) = li(1)
 
                                    Rem.
                                    '-- Ecriture dans un tableau
 
                                    '---
                                    Rem.
 
                                    'Colorier en jaune les lignes contenants CN
                                    If InStr(1, a$, "CN") > 0 Then
                                        Cells(LastLg, 1).Interior.ColorIndex = 6
                                    End If
                                    i = i + 1
                                End If
                            End If
                        End If
                        j = j + 1
                    Next Item
                End If
                ' Lecture d'une nouvelle ligne
                Line Input #Canal, a$
                If InStr(1, a$, "WO") > 1 Then
                    Line Input #Canal, a$
                ElseIf InStr(1, a$, "END") > 1 Then
                    Continue = False
                End If
            Loop
        End If
    End If
Loop
Close #Canal
 
Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
MsgBox "Sort complete.", vbInformation
 
'On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
 
[B10] = Timer - Start
 
MsgBox "Temp d'exécution" & [B10]
End Sub

Mais pour un gain de temps, j'aimerais utiliser un tableau pour lire le fichier et ainsi accélérer le temps d'exécution.

Comme j'espérais peaufiner ce code, s'il est possible

Merci d'avance.

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'Déclarations
'.....
Dim k as Long
Dim Tb
'.....
                                If InStr(StrLigne, "CL") = 0 Then
                                    Li = Split(Mot, "-")
                                    k = k + 1
                                    ReDim Preserve Tb(1 To 1, 1 To k)
                                    Tb(1, k) = Li(1)
'.....
 
'Et en fin
'.....
Close #Canal
With Worksheets("Feuil1")                          'à adapter
    LastLg = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Range("A" & LastLg).Resize(k, 1) = Application.Transpose(Tb)
    .Range("A1:A" & LastLg + k).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
End With
'....

[apt]

Bonsoir mercatog,

Il y a un problème avant d'affecter des lignes au tableau Tb.

En premier, il faut tester si la ligne lue contient un "L3" et avant de sauvegarder sa valeur numérique dans Tb, il faut que la ligne en dessous ne contienne pas un "CL".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
                            If InStr(1, Item, "L3-") > 0 And _
                               InStr(1, Item, "&") = 0 Then
                                ' Si la ligne suivante contient la chaine CL
                                ' on ne comptabilise pas la l'élément en cours
                                Line Input #Canal, a$    'ICI on devra relire cette ligne si elle ne contient pas de CL ???
                                If InStr(1, a$, "CL") = 0 Then

En piéce jointe un exemple du fichier texte à lire.

[mercatog]

Je n'ai pas refais ton code mais simplement t'ai montré comment remplir ta variable tableau Tb et comment transférer son contenu en une seule fois sur ta feuille Excel.

Mon code précédent n'est pas le code en entier mais la partie dans TON code qu'il faudrait changer

les '..... désigne les parties de TON code inchangées.

[apt]

Oui je sais que tu m'as montré comment remplir un tableau.

Mais avant de l'utiliser, je devrais trouver une solution pour la lecture d'une ligne n et tester si elle contient un "L3".

Une fois "L3" trouvée, je ferais lire une nouvelle ligne n+1 avec application d'un teste sur l'existence d'une chaine "CL".

Si le résultat est faux, il n'y aura pas extraction et sauvegarde de la valeur xxx dans L3-xxxx dans Tb et en même temps je ferais un autre test sur la ligne n+1 si elle contient un "L3"

Et ainsi de suite.

Si tu as ouvert le fichier texte joint, tu pourras peut-être trouver une meilleure solution pour résoudre ce problème

Bref, je ne devrais prendre que les numéros xxxx après les L3-xxxx avec l’état "ML" seulement.

Voila !

[apt]

Bonsoir,

Voila un nouveau code, avec une petite erreur :

L'indice n'appartient pas à la selection

Dans cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ReDim Preserve TbNC(1 To i, 1 To 1)

Le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub OuvreFichTab()
    Dim Tablo, TbNC()
    Dim Reponse As String
    Dim Canal As Integer
    Dim LigneEnCours As String
    Dim NombreEnCours As String
    Dim i As Integer
    Dim Start, EndStart
    Start = Timer
 
    With Columns("A")
        .ClearContents
        .Interior.Pattern = xlNone
    End With
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = "Faux" Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
    [A1].Value = "Numéro"
    'i = i + 1
    Do While Not EOF(Canal)
        Line Input #Canal, LigneEnCours
        If Len(Trim(LigneEnCours)) > 0 Then                 '-- Si la ligne est non vide
            LigneEnCours = Trim(LigneEnCours)
            Debug.Print "LigneEnCours = " & LigneEnCours
            If InStr(1, LigneEnCours, "L3-") > 0 Then
 
                If NombreEnCours <> "" Then
                    i = i + 1
                    ReDim Preserve TbNC(1 To i, 1 To 1)
                    TbNC(i, 1) = NombreEnCours
                    Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
                End If
                NombreEnCours = ""
                Tablo = Split(LigneEnCours, " ")
                NombreEnCours = Split(Tablo(0), "-")(1)
            ElseIf InStr(1, LigneEnCours, "CL") > 0 Then
                NombreEnCours = ""
            Else
                If NombreEnCours <> "" Then
                    i = i + 1
                    ReDim Preserve TbNC(1 To i, 1 To 1)
                    TbNC(i, 1) = NombreEnCours
                    Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(i, 1)
 
                End If
                NombreEnCours = ""
            End If
        End If
    Loop
    Close #Canal
    Range("A1").Resize(i, 1) = TbNC
    Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
    MsgBox "Sort complete.", vbInformation
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
 
    [B10] = Timer - Start
 
    MsgBox "Temp d'exécution : " & [B10]
End Sub

Bonsoir,

Avec ce code, le tableau TbNC() est bien rempli, mais je n'ai rien en le transposant dans la colonne A :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Sub OuvreFichTab()
    Dim Tablo, TbNC()
    Dim Reponse As String
    Dim Canal As Integer
    Dim LigneEnCours As String
    Dim NombreEnCours As String
    Dim i As Integer
    Dim Start, EndStart
    Start = Timer
 
    With Columns("A")
        .ClearContents
        .Interior.Pattern = xlNone
    End With
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    Reponse = Application.GetOpenFilename _
              ("All Files (*.*),*.*")
 
    If Reponse = "Faux" Then Exit Sub
    Canal = FreeFile
    Open Reponse For Input As #Canal
    [A1].Value = "Numéro"
    'i = i + 1
    Do While Not EOF(Canal)
        Line Input #Canal, LigneEnCours
        If Len(Trim(LigneEnCours)) > 0 Then                 '-- Si la ligne est non vide
            LigneEnCours = Trim(LigneEnCours)
            Debug.Print "LigneEnCours = " & LigneEnCours
            If InStr(1, LigneEnCours, "L3-") > 0 Then
 
                If NombreEnCours <> "" Then
                    i = i + 1
                    ReDim Preserve TbNC(1, i)
                    TbNC(1, i) = NombreEnCours
                    Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(1, i)
                End If
                NombreEnCours = ""
                Tablo = Split(LigneEnCours, " ")
                NombreEnCours = Split(Tablo(0), "-")(1)
            ElseIf InStr(1, LigneEnCours, "CL") > 0 Then
                NombreEnCours = ""
            Else
                If NombreEnCours <> "" Then
                    i = i + 1
                    ReDim Preserve TbNC(1, i)
                    TbNC(1, i) = NombreEnCours
                    Debug.Print "i = " & i & ", NombreEnCours = " & NombreEnCours & ", TbNC(" & i & ") = " & TbNC(1, i)
 
                End If
                NombreEnCours = ""
            End If
        End If
    Loop
    Close #Canal
    Range("A2").Resize(UBound(TbNC, 2), 1) = Application.Transpose(TbNC)
    'Range("A2").Resize(i, 1) = Application.Transpose(TbNC)
    Range("A1:A65000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
    MsgBox "Sort complete.", vbInformation
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
 
    [B10] = Timer - Start
 
    MsgBox "Temp d'exécution : " & [B10]
End Sub

[mercatog]

Fais un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Redim Preserve TbNC(1 To 1, 1 To i)

Sinon, essaies ce code après avoir adapté le nom de la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub OuvreFichTab()
Dim LigneEnCours As String, LigneSuivante As String, TbNC() As String
Dim Start As Single, EndStart As Single
Dim EnCours As Boolean
Dim Reponse As Variant
Dim Canal As Integer
Dim i As Long
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
 
Reponse = Application.GetOpenFilename("All Files (*.*),*.*")
 
If Reponse <> False Then
    Start = Timer
 
    Canal = FreeFile
    Open Reponse For Input As #Canal
 
    i = 1
    ReDim TbNC(1 To 1, 1 To 1)
    TbNC(1, 1) = "Numéro"
 
    Do While Not EOF(Canal)
        If Not EnCours Then
            Line Input #Canal, LigneEnCours
            LigneEnCours = Trim(LigneEnCours)
        Else
            LigneEnCours = LigneSuivante
        End If
 
        If Len(LigneEnCours) > 0 Then              '-- Si la ligne est non vide
            If InStr(LigneEnCours, "L3-") > 0 Then
                EnCours = True
                Line Input #Canal, LigneSuivante
                LigneSuivante = Trim(LigneSuivante)
                If Len(LigneSuivante) > 0 Then
                    If InStr(LigneSuivante, "CL") = 0 Then
                        i = i + 1
                        ReDim Preserve TbNC(1 To 1, 1 To i)
                        TbNC(1, i) = Split(Split(LigneEnCours)(0), "-")(1)
                    End If
                End If
            Else
                EnCours = False
            End If
        End If
        DoEvents
    Loop
    Close #Canal
 
    With Worksheets("Feuil1")                      'A adapter
        With .Range("A:A")
            .ClearContents
            .Interior.Pattern = xlNone
        End With
        .Range("A1").Resize(i, 1) = Application.Transpose(TbNC)
        .Range("A1:A" & i + 1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
    End With
End If
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
 
MsgBox "Temp d'exécution : " & Timer - Start
End Sub