Discussion :

[DRiZ0__]

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 :

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
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 :



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 :



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 .. !:)

[Menhir]

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 :

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
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 :

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
    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 :

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
    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.

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[DRiZ0__]

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 :

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
 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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Menhir]

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    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).

[DRiZ0__]

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 :

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
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?

[Menhir]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[tototiti2008]

Bonjour à tous,

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.

[Menhir]

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).

[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+

[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.