Bonjour a tous,

Je travaille actuellement sur la génération de KPI (Key Performance Indicator) pour l'un de mes projets.
Pour générer ces KPI, je récupère des informations à partir de 4 fichiers CSV.

La difficulté provient que l'un de ces 4 fichiers possède plus de 4,2 millions de lignes...

Pour pouvoir le traiter, j'utilise dans un premier temps une commande powershell qui me permet de le splitter en fichiers de 150000 lignes.
Par la suite, j'ouvre les fichiers un par un et je dois récupérer certaines lignes en fonction de 2 valeurs récupérées dans l'un des 3 autres fichiers CSV.

J'ai optimisé comme j'ai pu et j'en suis rendu actuellement à environ 28 min de traitement pour la récupération des informations dans le premier CSV, le split du second fichier CSV et la récupération des données de ce dernier.
Je n'ai pas encore pris en compte les 2 derniers fichiers, mais ils ne sont pas très gros donc cela ne devrait pas poser de problèmes.

Pour filtrer mes données, j'utilise .AutoFitler plutôt que de boucler sur toutes les lignes ou d'utiliser .Find et .FindNext car aprés tests, c'est le plus rapide.
Je fais également au préalable une simplification du fichier en supprimant les colonnes dont je n'ai pas besoin et les lignes dont certaines valeurs ne m’intéressent pas (utilisation de .AutoFilter ainsi que de .ClearContents. Ce dernier est plus rapide que .Range.Delete mais je dois utiliser .Sort avant afin de passer les lignes vides à la fin du fichier).

La ou ca coince, c'est que je dois enregistrer les valeurs qui intéressent dans un nouveau fichier. La seule méthode que j'ai trouvé est d'utiliser .Copy et .PasteSpecial. Cela engendre un ralentissement à la longue de la macro. Je n'ai pas réussi à "copier" les valeurs filtrées d'un classeur vers un autre même en utilisant .SpecialCells(xlCellTypeVisible).Value. Uniquement la première ligne de mon range filtré est copiée sur tout mon range de destination...

J'utilise bien évidement Application.ScreenUpdating = False sur tous mes fichiers pour gagner en performance.

Si vous avez d'autres idées, surtout pour éviter le Copy/Paste, je suis preneur

Pour information, voici 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
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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
Option Explicit
Option Private Module
 
Public Config_Sheet As Worksheet
 
Public Destination_Folder As Range
Public CSV_PS1_File As Range
 
Public Destination_Folder_Name As Range
 
Public RtD_SecondCSV As Range
 
Public CtD_SecondCSV As Range
 
'Initiatlisation des constantes
Private Sub fct_Initialisation()
    Set Config_Sheet = ThisWorkbook.Worksheets("Config")
 
    Set Destination_Folder = Config_Sheet.Range("B1")
    Set CSV_PS1_File = Config_Sheet.Range("B2")
 
    Set Destination_Folder_Name = Config_Sheet.Range("B3")
 
    Set RtD_SecondCSV = Config_Sheet.Range("B4")
 
    Set CtD_SecondCSV = Config_Sheet.Range("B5")
End Sub
 
 
'Fonction principale
Sub FormatageCSV()
 
    'Initialisation des constantes
    Call fct_Initialisation
 
    'Récupétation des données pour filtre dans le premier fichier CSV
    ValRange = fct_FirstCSV
 
    'Split du second fichier CSV
    CSVFile = "SecondCSV.csv"
    Dim TempFilesList As String
    TempFilesList = fct_SplitCSV(FolderPath, CSVFile, FolderPath & "Temp\")
 
    'Ouverture fichier XLSX de destination des données issues des fichiers split
    Set ExcelCSVApp = CreateObject("Excel.Application")
    Set ExcelCSV = ExcelCSVApp.Workbooks.Add
    ExcelCSVApp.Visible = False
    ExcelCSVApp.ScreenUpdating = False
 
    'Pour chaque fichier split
    Dim TempFiles As Variant
    For Each TempFiles In Split(TempFilesList, vbLf)
 
        'Ouverture du fichier
        Dim ExcelCSVTempApp As Excel.Application, ExcelCSVTemp As Workbook
        Set ExcelCSVTempApp = CreateObject("Excel.Application")
        Set ExcelCSVTemp = ExcelCSVTempApp.Workbooks.Open(Filename:=FolderPath & "Temp\" & TempFiles, Format:=4, Local:=True, Delimiter:=";")
        ExcelCSVTempApp.Visible = False
        ExcelCSVTempApp.ScreenUpdating = False
 
        'Simplification du fichier
        Call fct_SimplifyCSV(ExcelCSVTemp, CtD_SecondCSV.Value, RtD_SecondCSV.Value)
 
        'Recherche de la colonne correspondant à la premiere valeur à filtrer
        Dim Val1_Column As Range
        Set Val1_Column = ExcelCSVTemp.Worksheets(1).Rows(1).Find(what:="VALEUR 1", LookAt:=xlWhole)
 
        'Recherche de la colonne correspondant à la seconde valeur à filtrer
        Dim Val2_Column As Range
        Set Val2_Column = ExcelCSVTemp.Worksheets(1).Rows(1).Find(what:="VALEUR 2", LookAt:=xlWhole)
 
        'Récupération de la colonne du fichier split
        Dim Last_Column_Temp As Integer
        Last_Column_Temp = ExcelCSVTemp.Worksheets(1).Cells(1, ExcelCSVTemp.Worksheets(1).Columns.Count).End(xlToLeft).Column
 
        'Récupréation de la derniere ligne du fichier XLSX de destination
        Dim Last_Row As Long
        Last_Row = ExcelCSV.Worksheets(1).Cells(ExcelCSV.Worksheets(1).Rows.Count, 1).End(xlUp).Row
 
        'Pour chaque couple de valeurs à récupérer
        Dim Val As Variant
        For Each Val In Split(ValRange, ";")
            Dim Val1_Filter As String, Val2_Filter As String
            Val1_Filter = Split(Val, ",")(0)
            Val2_Filter = Split(Val, ",")(1)
 
            Dim Last_Row_Temp As Long
            If Not Val1_Column Is Nothing Then
 
                'Filtre de la premiere valeur
                ExcelCSVTemp.Worksheets(1).Range(ExcelCSVTemp.Worksheets(1).Cells(1, 1), ExcelCSVTemp.Worksheets(1).Cells(1, Last_Column_Temp)).AutoFilter Field:=Val1_Column.Column, Criteria1:=Val2_Filter
 
                Last_Row_Temp = ExcelCSVTemp.Worksheets(1).Cells(ExcelCSVTemp.Worksheets(1).Rows.Count, 1).End(xlUp).Row
 
                'Si il y a des résultats
                If Last_Row_Temp > 1 Then
                    If Not Val2_Column Is Nothing Then
 
                        'Filtre de la seconde valeur
                        ExcelCSVTemp.Worksheets(1).Range(ExcelCSVTemp.Worksheets(1).Cells(1, 1), ExcelCSVTemp.Worksheets(1).Cells(1, Last_Column_Temp)).AutoFilter Field:=Val2_Column.Column, Criteria1:=Val1_Filter
 
                        Last_Row_Temp = ExcelCSVTemp.Worksheets(1).Cells(ExcelCSVTemp.Worksheets(1).Rows.Count, 1).End(xlUp).Row
 
                        'Si il y a des résultats
                        If Last_Row_Temp > 1 Then
 
                            'Copie des valeurs dans le XLSX
                            ExcelCSVTemp.Worksheets(1).Range(ExcelCSVTemp.Worksheets(1).Cells(2, 1), ExcelCSVTemp.Worksheets(1).Cells(Last_Row_Temp, Last_Column_Temp)).SpecialCells(xlCellTypeVisible).Copy
 
                            ExcelCSV.Worksheets(1).Cells(Last_Row + 1, 1).PasteSpecial Paste:=xlPasteValues
                        End If
                    End If
                End If
            End If
        Next
 
        Set Val1_Column = Nothing
        Set Val2_Column = Nothing
 
        'Fermeture fichier split
        ExcelCSVTempApp.CutCopyMode = False
        ExcelCSVTemp.Close SaveChanges:=False
        ExcelCSVTempApp.Quit
 
        Set ExcelCSVTemp = Nothing
        Set ExcelCSVTempApp = Nothing
    Next
 
    'Replace ' and space dans fichier XLSX
    Call fct_SearchAndReplace("'", "", ExcelCSV)
    Call fct_SearchAndReplace(" ", "", ExcelCSV)
 
 
    'Fermeture fichier XLSX
    ExcelCSVApp.Visible = True
    ExcelCSVApp.ScreenUpdating = True
    ExcelCSV.SaveAs Filename:=FolderPath & "Formated\" & "SecondCSV.xlsx", FileFormat:=xlOpenXMLWorkbook
    ExcelCSV.Close
    ExcelCSVApp.Quit
 
    Set ExcelCSV = Nothing
    Set ExcelCSVApp = Nothing
End Sub
 
Private Sub fct_SimplifyCSV(ExcelWB As Workbook, CtD As String, RtD As String)
 
    'Suppression des colonnes inutiles
    Dim Column As Variant, Find As Range
    'Pour chaque colonne
    For Each Column In Split(CtD, ";")
        Set Find = ExcelWB.Worksheets(1).Rows(1).Find(what:=Column, LookAt:=xlWhole)
        If Not Find Is Nothing Then
            ExcelWB.Worksheets(1).Columns(Find.Column).Delete Shift:=xlToLeft
        End If
    Next
 
    Dim Last_Column As Integer
    Last_Column = ExcelWB.Worksheets(1).Cells(1, ExcelWB.Worksheets(1).Columns.Count).End(xlToLeft).Column
 
    'Suppression des lignes inutiles
    Dim Criteria As Variant, Filter As Variant, Filter_Column As String, Filter_Value As String
    'Pour chaque critere de filtrage
    For Each Criteria In Split(RtD, ";")
        'Pour chaque couple Colonne;Valeur à filtrer
        For Each Filter In Split(Criteria, "&")
            Filter_Column = Split(Filter, "=")(0)
            Filter_Value = Split(Filter, "=")(1)
 
            Set Find = ExcelWB.Worksheets(1).Rows(1).Find(what:=Filter_Column, LookAt:=xlWhole)
 
            'Si la colonne existe, on applique le filtre
            If Not Find Is Nothing Then
                ExcelWB.Worksheets(1).Rows(1).AutoFilter Field:=Find.Column, Criteria1:=Filter_Value
            End If
        Next
 
        If Not Find Is Nothing Then
            Dim Last_Line As Long
            Last_Line = ExcelWB.Worksheets(1).Cells(ExcelWB.Worksheets(1).Rows.Count, 1).End(xlUp).Row
 
            'Si il y a des résultats
            If Last_Line > 1 Then
                'On vide les lignes (plus rapide que .Delete)
                ExcelWB.Worksheets(1).Range(ExcelWB.Worksheets(1).Cells(2, 1), ExcelWB.Worksheets(1).Cells(Last_Line, Last_Column)).SpecialCells(xlCellTypeVisible).ClearContents
                'Désactivation du filtre
                ExcelWB.Worksheets(1).Columns(Find.Column).AutoFilter
 
                'On range les données pour mettre les lignes vide à la fin
                With ExcelWB.Worksheets(1).Sort
                    .SortFields.Add Key:=ExcelWB.Worksheets(1).Columns(Find.Column), Order:=xlAscending
                    .SetRange ExcelWB.Worksheets(1).Range(ExcelWB.Worksheets(1).Columns(1), ExcelWB.Worksheets(1).Columns(Last_Column))
                    .Header = xlYes
                    .Apply
                    .SortFields.Clear
                End With
            Else
                'Désactivation du filtre
                ExcelWB.Worksheets(1).Columns(Find.Column).AutoFilter
            End If
        End If
    Next
End Sub
 
Private Function fct_SplitCSV(InputFolder As String, InputFile As String, OutputFolder As String)
    'Initialisation des constantes
    Call fct_Initialisation
 
    'Génération du sript Powershell
    Dim FileNumber As Integer
    FileNumber = FreeFile
    Open CSV_PS1_File.Value For Output As #FileNumber
        Print #FileNumber, "$i=0; Get-Content """ & InputFolder & "\" & InputFile & """ -ReadCount 150000 | %{$i++; $_ | Out-File """ & OutputFolder & Mid(InputFile, 1, InStr(1, InputFile, ".") - 1) & "_Temp$i.csv""}"
    Close #FileNumber
 
    'Lancement du script PowerShell (utilisation d'une fonction perso plutot que Shell qui permet à la macro d'attendre la fin de l'execution de la commande)
    Call ExecCmd("powershell.exe -windowstyle hidden " & CSV_PS1_File.Value)
 
    'Récupération des fichiers générés
    Dim ListeFiles As Collection, Files As String
    Set ListeFiles = New Collection
    Files = Dir(OutputFolder)
    Do While Files <> ""
        ListeFiles.Add Files
        Files = Dir()
    Loop
 
    Dim Output_String As String, File As Variant
    For Each File In ListeFiles
        If InStr(1, File, "_Temp") <> 0 Then
            Output_String = Output_String & File & vbLf
        End If
    Next
    SplitHugeCSV = Left(Output_String, Len(Output_String) - 1)
End Function
 
'Remplace une chaine de caractere par une autre dans tout un Workbook
Private Sub fct_SearchAndReplace(Search As String, Replace As String, ExcelWB As Workbook)
    If Not ExcelWB.Worksheets(1).Cells.Find(what:=Search, LookAt:=xlPart) Is Nothing Then ExcelWB.Worksheets(1).Cells.Replace what:=Search, Replacement:=Replace, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
PS: J'ai modifié le nom de certaines constantes et j'ai enlevé un petit bout de code au début donc il se peut que j'ai oublié de déclarer certaines variables