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
|
Option Explicit
Dim adresse As String 'Adresse du dossier où sont les fichiers
Dim date_jour As Date 'Date du jour que l'on traite
Dim ligne_courante As Long 'Numéro de la prochaine ligne sur laquelle on peut écrire sur le fichier final
Dim nom_fichier_final As String 'Nom du fichier final
Dim Wk As Workbook 'Objet classeur représentant le fichier final
Dim noms_fichiers(1 To 250) As String 'Tableau où sont indiqués tous les noms des classeurs présents dans le dossier "adresse"
Sub Importation()
'Permet de ne pas afficher les alertes
Application.DisplayAlerts = False
'Récupération des données sur le classeur actuel
adresse = Cells(10, 2).Value 'de la forme C:\Users\
date_jour = Format(Cells(16, 2), "dd/mm/yyyy")
nom_fichier_final = Cells(15, 2).Value
'Initialisation des variables
ligne_courante = 9 '8 lignes d'entête donc prochaine ligne où les données peuvent être écrites est la n°9
'Création des variables limitées à la procédure
Dim Derniere_ligne_fichier_concatene As Long 'Numéro de la dernière ligne du fichier final
Dim j As Integer, i As Integer 'Variables d'itérations
Dim numero_fichier As Integer 'Numéro de fichier dans le dossier (indice du tableau noms_fichiers dans lequel le nom du fichier est indiqué)
numero_fichier = 1
'Récupération de tous les noms de fichiers présents dans le dossier et mémorisation dans le tableau noms_fichiers
noms_fichiers(numero_fichier) = Dir(adresse)
While noms_fichiers(numero_fichier) <> ""
If noms_fichiers(numero_fichier) <> nom_fichier_final & ".*" Then 'Pour éviter de prendre en compte le fichier final comme un fichier à concaténer si le programme a déja été appliqué au dossier
numero_fichier = numero_fichier + 1
noms_fichiers(numero_fichier) = Dir
Else
noms_fichiers(numero_fichier) = Dir
End If
Wend
'Création d 'un classeur, identification avec l'objet Wk et sauvegarde
Set Wk = Workbooks.Add
Wk.SaveAs (adresse & nom_fichier_final)
'Appel de la fonction permettant de remplir le fichier final
For i = 1 To numero_fichier - 1
If i = 1 Then
Call Remplissage_fichier_final(i, True)
Else
Call Remplissage_fichier_final(i, False)
End If
Next i
'Copie dans l'entete du fichier final de la date du jour
Wk.Activate
Cells(2, 3) = date_jour
'Comptage du nombre de ligne du fichier final
Derniere_ligne_fichier_concatene = Application.WorksheetFunction.CountA(Range("A:A")) + 3
'Trie des données par ordre chronologique
Range("A9:J" & Derniere_ligne_fichier_concatene).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A9:A" & Derniere_ligne_fichier_concatene), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A8:J" & Derniere_ligne_fichier_concatene)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Suppression des lignes en double
For j = Derniere_ligne_fichier_concatene To 10 Step -1
If CDec(CDate(Cells(j, 1))) = CDec(CDate(Cells(j - 1, 1))) Then
Rows(j).Select
Selection.EntireRow.Delete
End If
Next j
For i = 9 To Derniere_ligne_fichier_concatene
'Reconversion du format de date dans le bon sens...
If Day(Cells(i, 1)) < 13 Then
Cells(i, 1) = Format(Cells(i, 1), "dd/mm/yyyy hh:mm:ss")
End If
Next i
Wk.Save
Wk.Close
'Réactivation des alertes
Application.DisplayAlerts = True
MsgBox ("La concaténation est terminée. Le fichier est dans le dossier renseigné")
End Sub
Sub Remplissage_fichier_final(i As Integer, bool As Boolean)
'Création des variables locales
Dim Derniere_ligne As Integer
Dim l As Integer, j As Integer, k As Integer
'Création d 'un classeur, identification avec le fichier à concaténer
Dim Wk_valeurs As Workbook
Set Wk_valeurs = Workbooks.Open(adresse & noms_fichiers(i))
'Comptage du nombre de ligne du fichier à concatener
Derniere_ligne = Application.WorksheetFunction.CountA(Range("A:A")) + 3
'Copie de l'entête dans le cas où c'est le premier fichier à traiter
If bool = True Then
Wk_valeurs.Activate
Rows("1:8").Select
Selection.Copy
Wk.Activate
Range("A1").Select
ActiveSheet.Paste
End If
'Copie de la prochaine ligne à ajouter dans le fichier final
For l = 9 To Derniere_ligne
Wk_valeurs.Activate
Dim ligne(1 To 10) As Variant
'Problème avec les dates donc obligé de changer le format de la date en fonction du numéro du jour ...
If Day(Cells(l, 1)) < 13 Then
ligne(1) = Format(Cells(l, 1), "mm/dd/yyyy hh:mm:ss")
Else
ligne(1) = Format(Cells(l, 1), "dd/mm/yyyy hh:mm:ss")
End If
For j = 2 To 10
ligne(j) = Cells(l, j)
Next j
'Copie de la ligne dans le fichier final
Wk.Activate
If Int(CDec(CDate(ligne(1)))) = CDec(CDate(date_jour)) Then 'le fichier ne doit contenir que des données du même jour donc suppression de toutes les données concernant un jour different
For k = 1 To 10
Cells(ligne_courante, k) = ligne(k)
Next k
ligne_courante = ligne_courante + 1
End If
Next l
Wk_valeurs.Close
Wk.Activate
Wk.Save
End Sub |
