Discussion :

[issoram]

Bonjour,

J'aurais besoin de vos lumières et retours d’expérience sur la lecture et le rapatriement de données d'un fichier texte vers un classeur Excel.

Ayant moi même le besoin d'optimiser ce genre de traitement j'ai testé différentes méthodes. Outre la fonction OpenText d'Excel j'ai testé les fonctions ci dessous.

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
'1. Acces séquentiel méthode 1: ligne à ligne
Function lecture_seq1(pathfile As String, sep As String, ws As Worksheet)
 
    Dim intFic As Integer
    Dim strligne As String
    Dim splitLigne() As String
    Dim i As Long, j As Long, nb_col As Long
 
    i = 1
    intFic = FreeFile 
    Open pathfile For Input As intFic
 
    While Not EOF(intFic)
 
        Line Input #intFic, strligne
        splitLigne = Split(strligne, sep)
 
        'La premiere ligne d'entêtes détermine le nombre de colonnes
        If i = 1 Then
            nb_col = UBound(splitLigne) + 1
        End If
 
        With ws
            .Range(.Cells(i, 1), .Cells(i, nb_col)).Value = splitLigne
        End With
 
        i = i + 1
 
    Wend
 
    Close intFic
 
End Function
 
'2. Acces séquentiel méthode 2: lecture globale
Function lecture_seq2(pathfile As String, sep As String, ws As Worksheet) As Variant
 
    Dim oFSO As Scripting.FileSystemObject
    Dim oFl As Scripting.File
    Dim oTxt As Scripting.TextStream
    Dim str As String
    Dim contFichier() As String
    Dim splitLigne() As String, splitFic() As String
    Dim i As Long, j As Long, nbl As Long, nb_col As Long
    Dim contenu As String, csplit As Variant, lsplit As Variant
 
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject
    Set oFl = oFSO.GetFile(pathfile)
 
    'Ouverture
    Set oTxt = oFl.OpenAsTextStream(ForReading)
 
    'Lecture
    contenu = oTxt.ReadAll '-- Lit la totalité du fichier
    csplit = Split(contenu, vbCrLf)
    nbl = UBound(csplit)
 
    For i = 1 To nbl
        lsplit = Split(csplit(i - 1), sep)
        If i = 1 Then
            nb_col = UBound(lsplit) + 1
            ReDim contFichier(1 To nbl, nb_col)
        End If
        For j = 1 To nb_col
            contFichier(i, j) = lsplit(j - 1)
        Next j
    Next i
 
    oTxt.Close
 
    Set oTxt = Nothing
    Set oFSO = Nothing
    Set oFl = Nothing
 
    lecture_seq2 = contFichier
 
End Function
 
'3. Méthode pour connexion et requete directe via ADO:
' nécessite un fichier .ini
Sub lecture_ADO(path_dossier As String, file_name As String, Rg As Range)
 
    Dim Conn As ADODB.Connection
    Dim Rst As New ADODB.Recordset
    Dim Requete As String
 
    Set Conn = New ADODB.Connection
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & path_dossier & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
 
    Requete = "SELECT * FROM " & file_name
    Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
 
    'Copie des données vers la plage voulue
    Rg.CopyFromRecordset Rst
 
    Rst.Close: Conn.Close
    Set Rg = Nothing
    Set Conn = Nothing
 
End Sub

Pour un fichier texte (séparateur tab) de 4 colonnes et 100 000 lignes, voici les temps de traitement des différentes méthodes sur mon modeste PC.

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
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Sub run()
 
    Dim f1 As Worksheet
    Dim Debut As Long, Fin As Long
    Dim contenu_fichier As Variant
    Dim file_name As String, file_path As String
 
    Application.ScreenUpdating=False
 
    Set f1 = ThisWorkbook.Worksheets(1)
    file_path = "C:\Documents and Settings\NEO\Mes documents\"
    file_name = "test.txt"
 
    '1. lecture seq 1
    Debut = GetTickCount()
    lecture_seq1 file_path & file_name, vbTab, f1
    Fin = GetTickCount()
    Debug.Print "Temps mis en milli-secondes : " & (Fin - Debut) '20 906 millisec
    f1.Cells.ClearContents
 
    '2. lecture seq 2
    Debut = GetTickCount()
    contenu_fichier = lecture_seq2(file_path & file_name, vbTab, f1)
    f1.Range(f1.Cells(1, 1), f1.Cells(UBound(contenu_fichier, 1), UBound(contenu_fichier, 2))).Value = contenu_fichier
    Fin = GetTickCount()
    Debug.Print "Temps mis en milli-secondes : " & (Fin - Debut) '9 153 millisec
    f1.Cells.ClearContents
 
    '3. Methode ouverture Excel
    Debut = GetTickCount()
    Workbooks.OpenText filename:=file_path & file_name, DataType:=xlDelimited, Tab:=True
    Fin = GetTickCount()
    Debug.Print "Temps mis en milli-secondes : " & (Fin - Debut) '5 187 millisec
    ActiveWorkbook.Close
 
    '4. Méthode ADO
    Dim Rg As Range
    Set Rg = f1.Range("A1")
    Debut = GetTickCount()
    lecture_ADO file_path, file_name, Rg
    Fin = GetTickCount()
    Debug.Print "Temps mis en milli-secondes : " & (Fin - Debut)  '13 407 millisec
    Application.ScreenUpdating=True   
End Sub

Je me doutais bien que la méthode d'Excel serait la plus performante. Mais je suis étonné par la méthode via ADO. Est ce la copie du Recordset qui allonge le traitement (j'avoue ne pas trop maitriser le sujet).
Quoiqu'il en soit: me confirmer vous ces tendances pour des fichiers plus volumineux? Voyez vous des optimisations possibles aux méthodes ci dessus?
D'autres méthodes plus efficaces?

Merci d'avance

[kiki29]

Salut, à voir ici
Autrement cela dépend tellement du contexte
Par exemple pour, non pas des fichiers TEXTE mais des fichiers XLS : si tu dois lire qqs dizaines de fichiers xls même avec un antivirus qui s'activera à chaque ouverture, tu ne perdras pas "trop" de temps, du style 0.25 s par fichier, mais quand tu en as 25000 ou plus, le gain via ADO sera plus conséquent.

[issoram]

Merci pour le lien Kiki mais il concerne plus l'aspect taille du fichier que l'aspect performances. Je bosse sous 2010, donc mon problème n'est pas le nombre de lignes (de plus je ne charge pas des fichiers de plus de 1 million de lignes).

Par contre ta remarque sur ADO m’intéresse bien. .Pourquoi un tel gain quand le nombre de fichiers augmente?

Bonne soirée

[kiki29]

Re, comme précisé plus haut c'est une remarque pour les fichiers XLS si tu as un antivirus actif ( style Norton, AVG etc ) , pas pour les fichiers Texte.

[issoram]

Ok merci KiKi, j'ai lu trop vite.

Par contre ma question concerne plus les fichiers texte. Des idées sur le sujet?

[kiki29]

Re, à tester juste par curiosité :

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
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
 
Option Explicit
 
Dim Dep As Currency, Fin As Currency, Freq As Currency
 
'   Référence à cocher : Microsoft Forms 2.0 Object Library
Sub Tst()
Dim iNumFichier As Integer
Dim sStr As String
Dim sNomFichier As String
Dim sTxt As MSForms.DataObject
 
    Feuil1.Cells.Clear
    Set sTxt = New MSForms.DataObject
 
    QueryPerformanceCounter Dep
    Application.ScreenUpdating = False
    sNomFichier = ThisWorkbook.Path & "\" & "Test.txt"
    iNumFichier = FreeFile
 
    Open sNomFichier For Input As #iNumFichier
        sStr = Input$(LOF(iNumFichier), iNumFichier)
    Close #iNumFichier
 
    sTxt.SetText CStr(sStr)
    sTxt.PutInClipboard
 
    Feuil1.Range("A1").PasteSpecial
    Feuil1.Range("E1").Select
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = "Terminé : " & Format(((Fin - Dep) / Freq), "0.000 s")
 
    sTxt.SetText CStr("")
    sTxt.PutInClipboard
    Set sTxt = Nothing
 
    Application.ScreenUpdating = True
End Sub