Amélioration de l'importation de données [Résolu]

[Vincent32]

Bonjour à tous,

Bonne année et meilleurs voeux pour 2012 !

Je dispose du code suivant qui m'importe une série de fichiers texte (contenus dans un répertoire) constitués de 2 colonnes et d'une foultitude de lignes.

Le code m'importe uniquement la deuxième colonne.

Voici le code :

Code :

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
Sub Import()
 
    'Déclarations des variables
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
 
    'Attribution de valeurs
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder(Sheets("Macro").Range("E11").Value) 'nom du répertoire
 
    'Boucle sur fichiers du repertoire
    c = 2
        For Each FsoFichier In FsoRepertoire.Files
            i = 1
            'Vérifie si le fichier a l'extension souhaité
            str = Split(FsoFichier.Name, ".")
                If str(UBound(str)) = "dpt" Then
                    'ouvre le fichier
                    Open FsoFichier.Path For Input As #1
                        'Boucle sur chaque ligne du fichier
                        Do While Not EOF(1)
                            Line Input #1, strLigne
                            str = Split(strLigne, Chr(9))
                            'insere la ligne dans la cellule
                            Sheets("Données brutes").Cells(i, c).Value = str(1)
                            i = i + 1
                        Loop
                    Close #1
                    c = c + 1
                End If
        Next
 
    'Démarrage de la seconde macro
    Call Copie
 
End Sub
 
Sub Copie()
 
'Déclaration des variables
    Dim ws0 As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet
    Const PremL1 = 1 'Première ligne de données dans la feuille 1
    Const PremC1 = 1 'Première colonne de données dans la feuille 1
    Dim DerL1 As Long 'Dernière ligne de données dans la feuille 1
    Dim DerC1 As Long 'Dernière colonne de données dans la feuille 1
    Dim Col As Long
    Dim Lig As Long
    Dim Lign As Long
 
    'Attribution de valeurs
    Set ws0 = Worksheets("Macro")
    Set ws1 = Worksheets("Données brutes") 'L'objet Feuille 1 est attribué à la variable ws1
    Set ws2 = Worksheets("Soustraction") 'L'objet Feuille 2 est attribué à la variable ws2
    Set ws3 = Worksheets("Correction ligne de base") 'L'objet Feuille 3 est attribué à la variable ws3
    Set ws4 = Worksheets("N-(N-1)")
    Set ws5 = Worksheets("Dérivée première")
    Set ws6 = Worksheets("Dérivée seconde")
 
    'Recherche de la dernière ligne renseignée dans la colonne A de la feuille 1
    DerL1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    'Recherche de la dernière colonne renseignée dans la ligne 1 de la feuille 1
    DerC1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
 
    'Recopie de la colonne A de la feuille 1 dans les feuilles 2 et 3
    ws1.Range("A:A").Copy ws2.Range("A:A")
    ws1.Range("A:A").Copy ws3.Range("A:A")
    ws1.Range("A:A").Copy ws4.Range("A:A")
    'Recopie de la colonne A2 à ADerL1-1 de la feuille 1 dans la feuille 5
    ws1.Range(ws1.Cells(2, 1), ws1.Cells(DerL1 - 1, 1)).Copy ws5.Range("A1")
    'Recopie de la colonne A3 à ADerL1-2 de la feuille 1 dans la feuille 6
    ws1.Range(ws1.Cells(3, 1), ws1.Cells(DerL1 - 2, 1)).Copy ws6.Range("A1")
 
    'Enregistrement données brutes
        For Col = PremC1 To DerC1 - 2
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws1.[A:A].Copy [A1]
                    ws1.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E12] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E13] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
    'soustraire la colonne B de la feuille 1 à toutes les autres colonnes pour renseigner la feuille 2
        For Col = PremC1 To DerC1 - 2
            For Lig = PremL1 To DerL1
                ws2.Cells(Lig, Col).Offset(0, 1) = ws1.Cells(Lig, Col).Offset(0, 2) - ws1.Cells(Lig, PremC1 + 1)
            Next Lig
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws2.[A:A].Copy [A1]
                    ws2.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E14] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E15] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
    'soustraire la ligne 1090 de la feuille 2 à toutes les autres lignes pour renseigner la feuille 3
        For Col = PremC1 To DerC1 - 2
            For Lig = PremL1 To DerL1
                ws3.Cells(Lig, Col + 1) = ws2.Cells(Lig, Col + 1) - ws2.Cells(1090, Col + 1)
            Next Lig
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws3.[A:A].Copy [A1]
                    ws3.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E16] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E17] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
    'N-(N-1)
         For Col = PremC1 To DerC1 - 2
            For Lig = PremL1 To DerL1
                ws4.Cells(Lig, Col).Offset(0, 1) = ws3.Cells(Lig, Col).Offset(0, 2) - ws3.Cells(Lig, Col + 1)
            Next Lig
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws4.[A:A].Copy [A1]
                    ws4.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E18] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E19] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
    'dérivée première de la feuille 3 pour renseigner la feuille 5
        For Col = PremC1 To DerC1 - 2
            For Lig = PremL1 + 1 To DerL1 - 1
                ws5.Cells(Lig - 1, Col + 1) = (ws3.Cells(Lig + 1, Col + 1) - ws3.Cells(Lig - 1, Col + 1)) / (ws3.Cells(Lig + 1, 1) - ws3.Cells(Lig - 1, 1))
            Next Lig
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws5.[A:A].Copy [A1]
                    ws5.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E20] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E21] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
     'dérivée seconde de la feuille 3 pour renseigner la feuille 6
        For Col = PremC1 To DerC1 - 2
            For Lig = PremL1 + 1 To DerL1 - 1
                ws6.Cells(Lig - 1, Col + 1) = (((ws3.Cells(Lig + 3, Col + 1) - ws3.Cells(Lig + 1, Col + 1)) / (ws3.Cells(Lig + 3, 1) - ws3.Cells(Lig + 1, 1))) - ((ws3.Cells(Lig + 1, Col + 1) - ws3.Cells(Lig - 1, Col + 1)) / (ws3.Cells(Lig + 1, 1) - ws3.Cells(Lig - 1, 1)))) / (ws3.Cells(Lig + 2, 1) - ws3.Cells(Lig, 1))
            Next Lig
                    'ajout d'un classeur avec 1 feuille
                    Workbooks.Add 1
                    'copie des colonnes qui vont bien dans le nouveau classeur
                    ws6.[A:A].Copy [A1]
                    ws6.Cells(1, Col).Offset(0, 1).EntireColumn.Copy [B1]
                    'enregistrement au format txt
                    ActiveWorkbook.SaveAs ws0.[E22] & Col & ".txt", xlTextWindows
                    'enregistrement au format csv
                    ActiveWorkbook.SaveAs ws0.[E23] & Col & ".csv", xlCSV, Local:=True
                    'fermeture du classeur texte
                    ActiveWorkbook.Close False
        Next Col
 
    'Libère les ressources
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set ws3 = Nothing
    Set ws4 = Nothing
    Set ws5 = Nothing
    Set ws6 = Nothing
 
    'Message box pour indiquer la fin de la macro
    MsgBox "L'import et le traitement des données sont terminés et se sont déroulés correctement"
 
End Sub

Je souhaiterais améliorer l'importation :

- importation de la première colonne de mon premier fichier texte dans la colonne A
-importation de toutes les deuxièmes colonnes de tous mes fichiers textes les unes à la suite des autres (c'est le cas du code actuellement (et ça fonctionne)).
-importer le nom du fichier texte en tête de chaque colonne (cellule 1)

Par ailleurs pourriez vous m'indiquer dans quel ordre le code récupère mes fichiers texte (ordre alphabétique croissant ? taille du fichier ?)

Merci d'avance pour vos réponses,

Cordialement,

Vincent

[ZebreLoup]

Voilà ta procédure légèrement modifiée, ça devrait marcher. Par contre je pense vraiment que si tu avais bien compris cette procédure, tu aurais pu l'adapter très facilement... Ne copie pas les codes qu'on te donne sans réfléchir.

Code :

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
Sub Import()
 
    'Déclarations des variables
    Dim Fso As Object
    Dim FsoRepertoire As Object
    Dim FsoFichier As Object
    Dim i As Long
    Dim c As Integer
    Dim strLigne As String
    Dim str() As String
 
    'Attribution de valeurs
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set FsoRepertoire = Fso.GetFolder(Sheets("Macro").Range("E11").Value) 'nom du répertoire
 
    'Boucle sur fichiers du repertoire
    c = 2
        For Each FsoFichier In FsoRepertoire.Files
            i = 2
            'Vérifie si le fichier a l'extension souhaité
            str = Split(FsoFichier.Name, ".")
                If str(UBound(str)) = "dpt" Then
                    Sheets("Données brutes").Cells(1, c).Value = FsoFichier.Name
                    'ouvre le fichier
                    Open FsoFichier.Path For Input As #1
                        'Boucle sur chaque ligne du fichier
                        Do While Not EOF(1)
                            Line Input #1, strLigne
                            str = Split(strLigne, Chr(9))
                            'insere la ligne dans la cellule
                            Sheets("Données brutes").Cells(i, c).Value = str(1)
                            If c = 2 Then
                                Sheets("Données brutes").Cells(i, 1).Value = str(0)
                            End If
                            i = i + 1
                        Loop
                    Close #1
                    c = c + 1
                End If
        Next
 
    'Démarrage de la seconde macro
    Call Copie
 
End Sub

Pour ta deuxième question, je pense que c'est par ordre alphabétique. Après tu peux toujours d'abord les charger dans une liste et les trier comme tu veux ensuite.

[Vincent32]

Merci beaucoup pour ta réponse et ton aide. Le code semble tourner à merveille.
Une petite question toutefois :
est-il posible de s'affranchir de l'extension du nom du fichier par exemple :

blabla.txt => blabla

Encore merci

Vincent

[ZebreLoup]

Par exemple :

Code :

1
2
3
4
5
6
7
8
9
Public Function NomFichierSansExtension(nomFichier As String) As String
    Dim p As Integer
    p = InStrRev(nomFichier, ".")
    If p > 0 Then
        NomFichierSansExtension = Mid(nomFichier, 1, p - 1)
    Else
        NomFichierSansExtension = nomFichier
    End If
End Function

[Vincent32]

Bonjour,

Merci pour cette réponse. Cependant je n'y comprends rien, vous serait-il possible de m'expliquer votre code et comment il fonctionne. Je ne vois pas comment l'intégrer dans ma macro actuelle.

Merci pour votre aide,

Cordialement

Vincent

[ZebreLoup]

Par exemple

Code :

Sheets("Données brutes").Cells(1, c).Value = NomFichierSansExtension(FsoFichier.Name)

au lieu de

Code :

Sheets("Données brutes").Cells(1, c).Value = FsoFichier.Name

[Vincent32]

Merci beaucoup pour ton aide ça semble fonctionner tel que je le souhaite

Cordialement,

Vincent