Modification code VBA existant / import de plusieurs CSV

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,

Cela fait plusieurs années que je traîne sur le forum, y trouvant fréquemment la réponse à mes questions. Je tiens donc tout d'abord à remercier l'ensemble des membres du forum !

__________

Mon problème :

Je souhaite extraire les données de multiples fichiers csv de format ( A ; 5) avec A identiques pour l'ensemble des fichiers CSV mais variant entre 2000 et 100 000 lignes (selon la source des CSV).

J'utilise pour cela le code VBA suivant :
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 Sub compil_csv() Dim fichier_final, fichier, x, x2, chemin fichier_final = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B3").Value & "\Fichierfinal.csv" If Dir(fichier_final) <> "" Then Kill fichier_final chemin = ThisWorkbook.Path fichier = Dir(ThisWorkbook.Path & "\*.csv") i = 0 Do x = FreeFile Open chemin & "\" & fichier For Input As #x laChaine = Input(LOF(x), #x) Close #x x2 = FreeFile Open fichier_final For Append As #x2 Print #x2, laChaine Close #x2 i = i + 1 fichier = Dir Loop Until fichier = "" Workbooks.Open fichier_final, local:=True End Sub
Ce code me permet d'extraire les données de chaque fichier csv et de les agréger dans l'onglet 1 du fichier "Fichierfinal".
L'ensemble des fichiers sont agrégés sur les mêmes colonnes (image du dessous). Si bien que le fichier final agrégé est de taille ( (A+1)*nb fichier ; 5 ). Le +1 correspondant aux lignes vides entre les jeux de données de chaque fichier.

Ci dessous ce que j'arrive à faire actuellement avec ce code :

Pièce jointe 513588

La première colonne des CSV correspond à la date d'une mesure et la seconde à l'heure. Ces deux colonnes sont identiques pour tous les fichiers csv.

Au lieu que les données importées se succèdent lignes après lignes comme dans l'image ci dessus. Je souhaite que les fichiers CSV importés soient rangés par colonnes comme dans l'image ci dessous :

Pièce jointe 513589

Mes tentatives jusque là ont été d’essayer de modifier la "print area" et également de fouiller sur le forum ! sans succès.

Je m'en remets donc à votre savoir, merci par avance.

En espérant que ce sujet n'a pas été traité dans un autre thread .. !:)

Citation:

Envoyé par DRiZ0__

Je souhaite extraire les données de multiples fichiers csv de format ( A ; 5) avec A identiques pour l'ensemble des fichiers CSV mais variant entre 2000 et 100 000 lignes (selon la source des CSV).

J'utilise pour cela le code VBA suivant :

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin
 
    fichier_final = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B3").Value & "\Fichierfinal.csv"
 
    If Dir(fichier_final) <> "" Then Kill fichier_final
 
    chemin = ThisWorkbook.Path
 
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
 
    i = 0
    Do
        x = FreeFile
        Open chemin & "\" & fichier For Input As #x
        laChaine = Input(LOF(x), #x)
        Close #x
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x2, laChaine 
        Close #x2
        i = i + 1
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

Plus simple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
    Dim WB_Dest As Workbook, WS_Dest As WorkSheet
    Dim WB_Temp As Workbook
    Dim fichier_final As String, fichier As String, chemin As String
 
    fichier_final = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B3").Value & "\Fichierfinal.csv"
 
    If Dir(fichier_final) <> "" Then
        Set WB_Dest = Workbooks.Open fichier_final, local:=True
    Else
        Set WB_Dest = Workbooks.Add
    End If
    Set WS_Dest = WB_Dest.Worksheets(1)
    WS_Dest.ClearContents
 
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    Do Until fichier = ""
        Set WB_Temp = Workbooks.OpenText FileName:=chemin & "\" & fichier, Semicolon:=True
        WB_Temp.Worksheets(1).UsedRange.Copy WS_Dest.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
        WB_Temp.Close SaveChanges:=False
    Loop
 
    WB_Dest.Save

Cela dit, perso, je créerais un onglet par fichier CSV ce qui faciliterait grandement la suite des opération.
Parce qu'avec cette façon de tout mettre dans le même onglet, il est difficile de séparer ensuite les données pour créer des colonne par CSV source.

Donc ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
    Dim WB_Dest As Workbook, WS_Dest As WorkSheet
    Dim WB_Temp As Workbook, Def As Long
    Dim fichier_final As String, fichier As String, chemin As String
 
    fichier_final = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B3").Value & "\Fichierfinal.csv"
    If Dir(fichier_final) <> "" Then Kill fichier_final
 
    Def = SheetsInNewWorkbook
    SheetsInNewWorkbook = 1
    Set WB_Dest = Workbooks.Add
    SheetsInNewWorkbook = Def
 
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    Do Until fichier = ""
        Set WB_Temp = Workbooks.OpenText FileName:=chemin & "\" & fichier, _
                              DataType:=xlDelimited, Semicolon:=True, StartRow:=2, _
                              FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1))
        WB_Temp.Worksheets(1).Copy After:=WB_Dest.Worksheets(WB_Dest.Worksheets.Count)
        WB_Temp.Close SaveChanges:=False
        WB_Dest.Worksheets(WB_Dest.Worksheets.Count).Name = fichier
    Loop
    WB_Dest.Save

FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 1), Array(4, 1))

Petite remarque : le premier onglet reste vide. C'est voulu. Il permettra de créer la synthèse.

Citation:

La première colonne des CSV correspond à la date d'une mesure et la seconde à l'heure.

Il serait judicieux de les regrouper en une seule colonne pour avoir une chronologie simple.
C'est beaucoup plus compliqué d'avoir à traiter le jour et l'heure séparément.

Première chose, préparer les ligne en mettant toutes les dates possibles (à ajouter au second code) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Set WS_Dest = WB_Dest.Worksheets(1)
Set WS_Dest.Name = "All"
For Each WS_Temp In WB_Dest.Worksheets
    If WS_Temp.Name <> WS_Dest.Name Then Intersert(WS_Temp.UsedRange, WS_Temp.Columns("A:B")).Copy WS_Dest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next WS_Temp
 
WS_Dest.Range("C2:C" & WS_Dest.Cells(Rows.Count, 1).End(xlUp).Row).Formula = "=A2+B2"
WS_Dest.Range("C2:C" & WS_Dest.Cells(Rows.Count, 1).End(xlUp).Row).Copy
WS_Dest.Range("C2").PasteSpecial(xlPasteValues)
WS_Dest.Columns("A:B").Delete
WS_Dest.Columns("A").RemoveDuplicates Columns:=Array(1,2), Header:=xlYes
WS_Dest.Columns("A").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes

Avec ça, tu as une liste de toutes les dates présentes dans les fichiers CSV sans doublons et dans l'ordre chronologique.

Il ne reste plus qu'à scruter tous les onglets et à placer les données sur la ligne correspondante.
Mais je n'ai pas le temps ce soir de voir cette partie.
A+

Bonjour Menhir,

Merci beaucoup pour ta réponse complète. C'est très sympa.

Je comprends l'approche et c'est vrai que l'utilisation de Workbook.opentext semble plus simple.

Cependant, lors de l’exécution j'ai reçu une erreur de compilation "erreur ou variable attendue" sur la fonction Workbooks.opentext.

J'ai finalement décidé de suivre ton conseil et de créer d'abord plusieurs onglets (un par fichier) dans mon fichier de travail.

Je me suis servi du code suivant qui fonctionne correctement.
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 Sub ImportCSVs() Dim fPath As String Dim fCSV As String Dim wbCSV As Workbook Dim wbMST As Workbook Set wbMST = ThisWorkbook fPath = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B9").Value & "\" 'path to CSV files, include the final \ Application.ScreenUpdating = False 'speed up macro Application.DisplayAlerts = False 'no error messages, take default answers fCSV = Dir(fPath & "*.csv") 'start the CSV file listing On Error Resume Next Do While Len(fCSV) > 0 Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file wbMST.Sheets(ActiveSheet.Name).Delete 'delete sheet if it exists ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr Columns.AutoFit 'clean up display fCSV = Dir 'ready next CSV Loop Application.ScreenUpdating = True Set wbCSV = Nothing End Sub
Mon seul problème, les données importées ne considèrent pas les point virgules de séparations de mon csv comme des tabulations.
Ainsi je me retrouver avec des données du type Date;Heure;valeur;statut dans chacunes des cases de A pour l'ensemble des feuillets.

Je n'ai pas encore trouvé de solution pour modifier le type des données importéeS ou pour remplacer les ";" par des tabulations. (La fonction replace( range,";",vbTab) remplace uniquement dans la chaîne de caractère et ne permet donc pas de sauter des colonnes à chaque point virgule rencontré).

J'ai également essayé via l'enregistreur de commande mais je ne suis pas convaincu.
Code:

1 2 3 4 5 6 Range("A" & i).Select Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _ TrailingMinusNumbers:=True
J'espère trouver une solution prochainement, une idée ?

Bonne soirée et encore merci

30/10/2019, 09h51
Menhir

Citation:

Envoyé par DRiZ0__

Mon seul problème, les données importées ne considèrent pas les point virgules de séparations de mon csv comme des tabulations.
Ainsi je me retrouver avec des données du type Date;Heure;valeur;statut dans chacunes des cases de A pour l'ensemble des feuillets.

Parce que tu utilises Open au lieu de OpenText.
OpenText à l'avantage non seulement de spécifier le séparateur de données mais aussi d'indiquer la nature des données et même l'ordre des trois éléments (jour, mois, année) pour les dates, ce qui me semble indispensable pour ton application.

Lire ça : https://docs.microsoft.com/fr-FR/off...books.opentext

Citation:

J'ai également essayé via l'enregistreur de commande mais je ne suis pas convaincu.

Code:

Selection.TextToColumns

TextToColumns ne fait rien de plus que ce que fait le OpenText (d'ailleurs, leurs syntaxes sont très proches).
Sauf que ce qui a pu être détérioré par le Open ne pourra pas être corrigé (ou très difficilement).

Bonjour Menhir,

Merci pour ces éléments.

Sur tes conseils, j'ai adapté la macro avec opentext. Cependant, en utilisant en effet les ";" comme délimiteurs avec Semicolon = True, le problème reste le même.

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
Sub ImportCSVs()
 
Dim fPath   As String
Dim fCSV    As String
Dim wbCSV   As Workbook
Dim wbMST   As Workbook
Set wbMST = ThisWorkbook
 
fPath = Workbooks("Fichier d'import1").Sheets("Sheet1").Range("B9").Value & "\"  'path to CSV files, include the final \
Application.ScreenUpdating = False  'speed up macro
Application.DisplayAlerts = False   'no error messages, take default answers
fCSV = Dir(fPath & "*.csv")         'start the CSV file listing
On Error Resume Next
Do While Len(fCSV) > 0
Workbooks.OpenText Filename:=fPath & fCSV, DataType:=xlDelimited, Semicolon:=True, Startrow:=2, FieldInfo:=Array(Array(1, 4), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1))
        Set wbCSV = ActiveWorkbook
wbMST.Sheets(ActiveSheet.Name).Delete                       'delete sheet if it exists
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)    'move new sheet into Mstr
Columns.AutoFit             'clean up display
fCSV = Dir                  'ready next CSV
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
 
End Sub

Les feuillets ainsi créés ne présentent toujours pas de saut de colonne pour les points virgules.

Peut-être l'utilisation de opentext est mal effectuée?

30/10/2019, 12h23
Menhir
Citation:

Envoyé par DRiZ0__

Sur tes conseils, j'ai adapté la macro avec opentext. Cependant, en utilisant en effet les ";" comme délimiteurs avec Semicolon = True, le problème reste le même.
Les feuillets ainsi créés ne présentent toujours pas de saut de colonne pour les points virgules.

C'est la première fois que je verrais le paramètre Semicolon:=True ne pas dissocier des données séparées par des points-virgules.
Es-tu certain que c'est bien ce caractère qui sépare tes données ? Peux-tu montrer une copie d'écran d'une partie de ce que tu récupères ?

Dans ton codes, il y a plusieurs éléments perturbants.

Déjà, tu devrais supprimer (ou mettre en commentaire) Application.ScreenUpdating = False et Application.DisplayAlerts = False. En phase de développement, ils n'ont aucun intérêt mais peuvent masquer des problèmes et compliquer leur résolution.

Plus grave, le On Error Resume Next à bannir absolument : on ne fait pas du développement les yeux bandés.
Ca donne l'impression que ton code générait des erreurs et, plutôt que chercher à les corriger, tu as chercher à les masquer d'un coup de baguette magique.

Il y a aussi cet enchainement :
Code:

1 2 3 4 Workbooks.OpenText Filename:=fPath & fCSV .... Set wbCSV = ActiveWorkbook wbMST.Sheets(ActiveSheet.Name).Delete ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
En ligne 3, tu fais référence à une feuille de wbMST mais portant le nom d'une feuille de wbCSV (puisque c'est le classeur actif à cet instant), ce qui n'est pas logique.

Tu supprimes l'onglet actif (ligne 3) et, juste après, tu fais référence à une ActiveSheet sans avoir activé une feuille spécifique.
C'est un peu comme jouer à la roulette.

Je peux me tromper mais j'ai l'impression que tu as récupéré un code quelque part, que tu as chercher à le modifier "au petit bonheur" sans chercher à comprendre ses éléments avec l'aide VBA, que ça t'a fait plein d'erreurs et que tu as mis un On Error Resume Next sur tout ça en te disant que, "pas vu pas pris", une erreur qu'on ne voit pas équivaut à un fonctionnement correct.
J'espère pour toi que je me trompe.
30/10/2019, 12h38
tototiti2008

Bonjour à tous,

Citation:

C'est la première fois que je verrais le paramètre Semicolon:=True ne pas dissocier des données séparées par des points-virgules.

Un vague souvenir me dit que j'ai déjà vu ça, lié aux paramètres régionaux du système il me semble. OpenText a un paramètre Local, pour tester tu pourrais réessayer en ajoutant Local:=False (puis Local:=True) pour voir si ça change le résultat.
30/10/2019, 13h37
Menhir

Citation:

Envoyé par tototiti2008

Un vague souvenir me dit que j'ai déjà vu ça, lié aux paramètres régionaux du système il me semble. OpenText a un paramètre Local

Le paramètre régional peut avoir une influence si on se contente d'un Open et qu'on laisse Excel choisir ce qui lui semble logique comme séparateur.
Mais si on utilise OpenText et qu'on force le séparateur, je ne vois pas comment il pourrait passer à travers.

Il m'est arrivé aussi avec OpenText d'avoir trop de colonnes parce que je n'avais pas passé à False un séparateur qui restait par défaut.
Mais le cas présenté ici, je ne l'ai pas encore rencontré.

Cala dit, faire l'essai que tu indiques, ça ne peut pas faire de mal (on ne sait jamais).
30/10/2019, 13h44
tototiti2008

Bonjour Menhir,

Tu as sans doute raison, il se peut que mes souvenirs me trompent. Mais il me semble cependant qu'il y avait un soucis spécifique sur les CSV, les américains utilisent des virgules comme séparateur et que ça écrasait certains paramètres. Mon test coûte peu cher à faire, dites moi ce que ça donne ça m'intéresse.
30/10/2019, 13h47
DRiZ0__

Bonjour à tous les deux,

Ça fonctionne ! La suggestion de tototiti2008 était correcte. En modifiant le critère Local de Opentext en False les sauts de colonne sont effectifs lors de l'import de mes données.

En effet Menhir, le code en question a été récupéré sur internet et "adapté" à ma situation.

Comme pour l'instant sur mon jeu de données relativement faible ( ~ soixante fichier csv) je pouvais vérifier la qualité de l'import je n'ai pas pensé à retirer le On Error Resume Next. Mais cela n'a pas de sens de garder le garder à l'avenir.

Pour les Screenupdating= False, j'avais en effet pris l'habitude de travailler tout le temps avec pour fluidifier l’exécution, mais réflection faite, il est vrai qu'en phase de développement cela peut me faire passer à coté de quelque chose.

Un grand merci à tous les deux pour ces informations. Cette première expérience sur la forum a été très instructive.

Bonne journée A+