Opérations sur fichiers multiples .csv

Version imprimable

05/07/2016, 18h39
CyberLudo

1 pièce(s) jointe(s)

Opérations sur fichiers multiples .csv

Bonjour,

Je vais essayer d'être clair dans ma demande :
J'ai sur un répertoire plus de 200 fichiers .csv. Ces fichiers sont tous constitués de la même façon :
- La première ligne constituée d'infos sur le fichier
- La deuxième ligne les entêtes de colonnes (12 colonnes utilisées)
- les lignes suivantes sont constituées des données (le nombre de lignes varie entre 2 et 1000)

Mon besoin sur chaque fichier :
1 - Recopier la valeur de la cellule F1 en fin de toutes les lignes constituées des données (dans la colonne M)
2 - ensuite supprimer la ligne 1 (infos sur le fichier)

Une fois cela fait sur chaque fichier, il faut que tous ces fichiers se transforme en 1 seul (avec une seule ligne d'entêtes bien sûr ! lol)

Voilà... jz sais j'en demande beaucoup mais j'y pige queudale et ça fait 3 jours que je cherche mais bon quand on est nul on est nul!!!

En PJ je vous mets un des fichiers mais en format xls car le csv est pas toléré en PJ
05/07/2016, 19h05
eric4459

Bonjour CyberLudo,
Voici quelques liens qui pourront te servir
http://www.developpez.net/forums/d21...r-excel-macro/
Remplace .xls par .csv

Sinon ceci que je considère comme une référence
http://silkyroad.developpez.com/

Bonne lecture, bon courage et bon apprentissage, si tu as des questions n’hésites pas à revenir par ici;)
Eric
06/07/2016, 11h39
CyberLudo

merci pour les liens

Je bidouille mais pour l'instant j'arrive juste à "compiler" des fichier en un seul mais pas à faire la copie de valeur sur chaque ligne de fichier...

1 pièce(s) jointe(s)

Salut Ludo,
Tu as peut-être trouvé une solution par toi-même, sinon voici ce que j'ai fais et testé.
Il faut que tu crée un sous-dossier contenant tes fichier Csv dans le dossier où tu enregistrera le fichier joint qui contient la macro et que tu nommes ce sous-dossier "Fichier Csv" (Tu peut lui donner un autre nom mais il faut aussi renommer la ligne qui suit dans le code)

Code:

CheminSrc = CheminDest & "\" & "Fichier Csv"

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
Sub Synthese()
Dim Recap As Worksheet 'Défini la feuille où les données seront copiées
Dim ShCsv As Worksheet 'Défini la feuille du fichier Csv à copier
Dim Orig As Range
Dim Dest As Range
Dim NbLigne1 As Integer
Dim NbLigne2 As Integer
Dim i As Integer
Dim CheminDest As String
Dim CheminSrc As String
Dim Fichier As String
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim D As Object 'déclare la variable D (Dossier)
Dim EF As Object 'déclare la variable EF (Ensemble de Fichiers)
Dim F As Object 'déclare la variable F (Fichier)
Set Recap = ThisWorkbook.Sheets("RECAP") 'Défini la feuille où coller les données
Set Dest = Recap.Range("A2") 'Défini la cellule où coller les données
Application.DisplayAlerts = False 'désactive les fenetres de demande de confirmation avant suppression
 
 
CheminDest = ThisWorkbook.Path ' Chemin de ce fichier - celui qui contient la Macro-
CheminSrc = CheminDest & "\" & "Fichier Csv" 'Chemin du dossier qui contient les fichier Csv (J'ai mis mes fichiers test dans un sous-dossier nommé "Fichier Csv" qui est lui même dans le dossier qui contient mon fichier avec ma macro. Clair??? ;-0 )
 
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichier SF
Set D = SF.GetFolder(CheminSrc) 'définit le dossiers D
Set EF = D.Files 'définit l'ensembles des fichiers EF du dossier D
 
For Each F In EF 'boucle sour tous les fichiers F de l'ensemble de ficiers EF
 
     Workbooks.Open F 'On ouvre le fichier
     Set ShCsv = Sheets(1) 'On Défini la feuille Source
 
     With ShCsv
        NbLigne1 = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille source
     End With
 
     For i = 3 To NbLigne1 ' On boucle sur toutes les lignes
        Range("M" & i) = Range("F1") 'On colle la valeur de la Cellule "F1" en colonne M
     Next i
 
     With Recap
        NbLigne2 = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille source
     End With
 
     Range("A3", "M" & NbLigne1).Copy 'On copie les données de la feuille
 
     Dest.Offset(NbLigne2 - 1, 0).PasteSpecial 'On colle les données
 
     ActiveWorkbook.Close True 'ferme et enregistre le classeur F
 
Next F 'prochain fichier de la boucle
 
 
 
 
End Sub

Dis moi si ça te vas
Pièce jointe 214979
Eric

1 pièce(s) jointe(s)

Rebonjour,
J'avais oublié un détail :oops:
La suppression de la première ligne de chaque fichier CSV ;)

Code:

Rows("1:1").Delete Shift:=xlUp ' On supprime la premiere ligne

J'ai egalement ajouté ceci:

Code:

Application.ScreenUpdating = False

Code:

Application.ScreenUpdating = True

ces deux lignes, placées en début et en fin de code empêchent le "rafraîchissement" de l'écran ce qui fait que tu ne verras plus les fichiers CSV s'ouvrir, copier les données etc... tu resteras sur la feuille que tu vois quand tu lances la macro.

Voici donc le code modifié et le fichier joint

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
Sub Synthese()
Dim Recap As Worksheet 'Défini la feuille où les données seront copiées
Dim ShCsv As Worksheet 'Défini la feuille du fichier Csv à copier
Dim Dest As Range
Dim NbLigne1 As Integer
Dim NbLigne2 As Integer
Dim i As Integer
Dim CheminDest As String
Dim CheminSrc As String
Dim Fichier As String
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim D As Object 'déclare la variable D (Dossier)
Dim EF As Object 'déclare la variable EF (Ensemble de Fichiers)
Dim F As Object 'déclare la variable F (Fichier)
Set Recap = ThisWorkbook.Sheets("RECAP") 'Défini la feuille où coller les données
Set Dest = Recap.Range("A2") 'Défini la cellule où coller les données
Application.DisplayAlerts = False 'désactive les fenetres de demande de confirmation avant suppression
Application.ScreenUpdating = False
 
 
CheminDest = ThisWorkbook.Path ' Chemin de ce fichier - celui qui contient la Macro-
CheminSrc = CheminDest & "\" & "Fichier Csv" 'Cemin du dossier qui contient les fichier Csv (J'ai mis mes fichiers test dans un sous-dossier nommé "Fichier Csv" qui est lui même dans le dossier qui contient mon fichier avec ma macro. Clair??? ;-0 )
 
Set SF = CreateObject("Scripting.FileSystemObject") 'définit le système de fichier SF
Set D = SF.GetFolder(CheminSrc) 'définit le dossiers D
Set EF = D.Files 'définit l'ensembles des fichiers EF du dossier D
 
For Each F In EF 'boucle sour tous les fichiers F de l'ensemble de ficiers EF
 
     Workbooks.Open F 'On ouvre le fichier
     Set ShCsv = Sheets(1) 'On Défini la feuille Source
 
     With ShCsv
        NbLigne1 = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille source
     End With
 
     For i = 3 To NbLigne1 ' On boucle sur toutes les lignes
        Range("M" & i) = Range("F1") 'On colle la valeur de la Cellule "F1" en colonne M
     Next i
 
     Rows("1:1").Delete Shift:=xlUp ' On supprime la premiere ligne
 
     With Recap
        NbLigne2 = .Cells(.Rows.Count, 1).End(xlUp).Row ' Compte le nombre de ligne de la feuille source
     End With
 
     Range("A2", "M" & NbLigne1).Copy 'On copie les données de la feuille
 
     Dest.Offset(NbLigne2 - 1, 0).PasteSpecial 'On colle les données
 
     ActiveWorkbook.Close True 'ferme et enregistre le classeur F
 
Next F 'prochain fichier de la boucle
 
 
Application.ScreenUpdating = True
 
End Sub

Pièce jointe 215004

Eric

08/07/2016, 19h38
patricktoulon

re

Bonjour
si j'ai bien compris o
uvrir 200csv pour prendre la f1 et la metrre en "m" sur la derniere ligne vide dispo si j'ai bien compris puis compiler dans un seul classeur
garder la ligne 1(titre/entete de colonne ) bien entendu une seul fois

et bien moi j'utiliserait pas excel
tout du moins je me servirait de
1 open for output as#X (en texte)
2 récupère le split (delà ligne 1 sur le 6 eme ";"
3 ajouterait ";;;;;" et ce que j'ai prélevé en 1 ere ligne a la fin
4 puis avec open mais cette fois ci en append(met ajour le fichier ne le réécrit pas ) mettre cela dans un nouveau fichier .csv

a la fin ouverture du fichier compilé
et voila
je suis certain que c'est plus rapide
08/07/2016, 19h42
eric4459

Bonjour Patrick

Citation:

Envoyé par patricktoulon

Bonjour

1 open for output as#X (en texte)
2 récupère le split (delà ligne 1 sur le 6 eme ";"
3 ajouterait ";;;;;" et ce que j'ai prélevé en 1 ere ligne a la fin
4 puis avec open mais cette fois ci en append(met ajour le fichier ne le réécrit pas ) mettre cela dans un nouveau fichier .csv

C'est quoi ce code ? du Vbsript? autre chose? en tous cas du chinois pour moi :calim2:

Eric

qu'est ce que tu raconte tu connais pas open for ... en vba ???????
Code:

1 2 3 4 5 6 7 8 Sub testlecture2() Dim laChaine As String, x, fichier As String fichier = "C:\Users\polux\Desktop\test2.csv"' fait le test en mettant un bon chemein pour toi x = FreeFile Open fichier For Input As #x laChaine = Input(LOF(x), #x) Close #x MsgBox laChaine
il est facile après de splitter lachaine par vbcrlf(saut de ligne)
le premier split et les infos si j'ai bien compris
donc on split la première ligne par les ";" on garde le 6 eme

le 2 eme c'est les entête (on garde q'une fois )
et on garde qu'a partir de la 3 eme ligne

on reprend un ope mais en appenfd et non ouput pour inscrire dans un nouveau fichier
on met tout a partir de la 3 eme ligne
on ajoute ";;;;;" et le f1 récupéré précédemment
on ferme le nouveau fichier ( temps d'exécution imperceptible tellement c'est du rapidos a gogo)

etc...etc... pendant 200 fois

donne moi 2 csv je te fait un exemple

c'est pas du vbs mais bien du vba open n'existe pas en vbs c'est le FSO

allez j'en rajoute une couche
création et écriture en mode mise a jour (APPEND)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub test_ecriture() ' EN MODE APPEND x = FreeFile fichier = "C:\Users\polux\Desktop\test2.txt" texte = Array("eric a compris", "eric a pas compris", "eric a compris", "eric a pas compris", "eric a compris", "eric a pas compris", "eric a compris", "eric a pas compris", "eric a compris", "eric a pas compris") fin = " bon!! tu decide!!" For i = 1 To UBound(texte) x = FreeFile Open fichier For Append As #x Print #x, texte(i) & ";" & vbCrLf If i = UBound(texte) Then Print #x, fin & ";" & vbCrLf Close #x Next End Sub
open for.... créé le fichier si il existe pas automatiquement

en mode input il li le fichier
en mode output il ecrit le fichier :écrase l'existant si c'est le cas
en mode append ajoute le texte

t'a compris ???

pour le fun ajoute juste au dessus de "end sub"

Code:

Workbooks.Open fichier

ca te donne une idée a quel point c'est rapide de: créer le fichier, le mettre 10 fois a jour en le fermant a chaque fois, et enfin l'ouvrir

beep beep!!!!!

09/07/2016, 00h41
eric4459

Salut Patrick,
Eh Ben non je ne connais pas :/
Je pensais connaitre le Ba-Ba alors que j'en suis toujours au BA :-(
Promis je vais étudier ;)
Eric
11/07/2016, 12h01
CyberLudo

Salut Eric

J'ai suivi tes instructions et surtout bien regardé le code pour comprendre (c'est ça l'important).
Ensuite j'ai lancé sur les deux cents fichiers... ça m'a bien fait une compil des données des fichiers dans le fichier mais, au lieu d'avoir les données dans les colonnes adéquat, tout c'est mis en colonne A avec des ; en séparateurs???

De plus je ne vois toujours pas comment mettre la la valeur en fin de ligne sur toutes les lignes avant de faire la "compil"
11/07/2016, 12h16
patricktoulon

re

re
heu ...si je ne me trompe pas dans la syntaxe

Code:

workbooks.open("tonfichier final.csv",Local:=True)

donne moi deux fichiers bidon remplissant tes critères je te fait un exemple
11/07/2016, 12h24
CyberLudo

2 pièce(s) jointe(s)

RE RE

En PJ je t'ai mis les deux premiers fichiers de ma série. Il sont en Xls mais normalement c'est du CSV
11/07/2016, 12h35
patricktoulon

re

ok je prends
dis moi quelle cellule tu veux récupérer pour la mettre a la fin
11/07/2016, 12h36
Marc-L

Bonjour, bonjour !

Renommer les fichiers .csv en .csv.txt pour les joindre …

Voilà, voilà !

_________________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …
11/07/2016, 12h40
CyberLudo

RE RE

alors il s'agit de la F1 qu'il faut remettre en fin de chaque ligne en colonne M

re
bon je vais voir pour la f1 en m
en attendant voila comment je compil

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub compil_csv()
    Dim fichier_final, fichier, x, chemin
 
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    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
            fichier = Dir
           Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

voila normalement ca doit être bon
j'ai fait sauter la première ligne, garder l'entête et mis f1 a chaque fin de ligne

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 compil_csv()
    Dim fichier_final, fichier, x, chemin
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    Do
       i = i + 1
        x = FreeFile
        Open chemin & "\" & fichier For Input As #x
        laChaine = Input(LOF(x), #x)
        Close #x
        tabl = Split(laChaine, vbCrLf)
        f1 = Split(tabl(0), ";")(5)
        If i = 1 Then texte = texte & tabl(1) & vbCrLf
        For i = 2 To UBound(tabl)
            texte = texte & tabl(i) & ";" & f1 & vbCrLf
        Next
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, texte
        Close #x
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

quelque petite correction notamment une ligne vide a la fin qui mettait le f1 en 2 eme cellule
j'ai oublier de dire que le chemin d'accès au fichier final doit être différent des csv originals

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin, old_fichier
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    If Dir(fichier_final) <> "" Then Kill fichier_final
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    i = 0
    Do
        x = FreeFile
        If fichier <> old_fichier Then
            Open chemin & "\" & fichier For Input As #x
            laChaine = Input(LOF(x), #x)
            Close #x
            old_fichier = fichier
            tabl = Split(laChaine, vbCrLf)
            f1 = Split(tabl(0), ";")(5)
            If i = 0 Then texte = texte & tabl(1) & ";cellule F1" & vbCrLf
            For i = 2 To UBound(tabl)
                texte = texte & tabl(i) & IIf(tabl(i) <> "", ";" & f1 & vbCrLf, "")
            Next
        End If
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, texte
        Close #x
        i = i + 1
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

11/07/2016, 13h51
CyberLudo

RERE

j'ai copié le code dans un fichier "compliateur.xls" que j'ai mis dans un répertoire de mon C:
C:\Users\Public\LOGICIELS\VIP\

J'ai mis tous les fichiers dans un sous dossier C:\Users\Public\LOGICIELS\VIP\Fichiers\

J'ai lancé la macro et : L'indice n'appartient pas à la sélection !

et une dernière j'avais oublié de réinitialiser la variable texte ce qui avait pour conséquence un répétition
voila maintenant c'est Nikel
avec cette méthode tu ouvre le fichier en format texte et en mémoire c'est pour cela que c'est plus rapide

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\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
            old_fichier = fichier
            tabl = Split(laChaine, vbCrLf)
            f1 = Split(tabl(0), ";")(5)
            If i = 0 Then texte = texte & tabl(1) & ";cellule F1" & vbCrLf
            For i = 2 To UBound(tabl)
                texte = texte & tabl(i) & IIf(tabl(i) <> "", ";" & f1 & vbCrLf, "")
            Next
 
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, texte
        Close #x
        i = i + 1: texte = ""
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

11/07/2016, 13h58
patricktoulon

1 pièce(s) jointe(s)

Citation:

Envoyé par CyberLudo

j'ai copié le code dans un fichier "compliateur.xls" que j'ai mis dans un répertoire de mon C:
C:\Users\Public\LOGICIELS\VIP\

J'ai mis tous les fichiers dans un sous dossier C:\Users\Public\LOGICIELS\VIP\Fichiers\

J'ai lancé la macro et : L'indice n'appartient pas à la sélection !

a tu changé le chemin des csv dans la macro au moins ????

pour toi normalement ca doit être cela

Code:

chemin = ThisWorkbook.Path &"\Fichiers"

et récupère le dernier code il au top plus de coquille
sinon teste avec mon exemplaire ci joint en laissant le dossier comme tel il faut déziper bien sur !!!

1 pièce(s) jointe(s)

voila si ton compliateur est dans VIP et que tes fichiers sont dans vip\Fichiers
alors voila

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    If Dir(fichier_final) <> "" Then Kill fichier_final
    chemin = ThisWorkbook.Path & "\Fichiers"
    fichier = Dir(ThisWorkbook.Path & "\Fichiers\*.csv")
    i = 0
    Do
        x = FreeFile
 
            Open chemin & "\" & fichier For Input As #x
            laChaine = Input(LOF(x), #x)
            Close #x
            old_fichier = fichier
            tabl = Split(laChaine, vbCrLf)
            f1 = Split(tabl(0), ";")(5)
            If i = 0 Then texte = texte & tabl(1) & ";cellule F1" & vbCrLf
            For i = 2 To UBound(tabl)
                texte = texte & tabl(i) & IIf(tabl(i) <> "", ";" & f1 & vbCrLf, "")
            Next
 
        x2 = FreeFile
        Open fichier_final For Append As #x2
        Print #x, texte
        Close #x
        i = i + 1: texte = ""
        fichier = Dir
    Loop Until fichier = ""
    Workbooks.Open fichier_final, local:=True
End Sub

Pièce jointe 215163

11/07/2016, 14h06
CyberLudo

Merci pour ton aide et à toi aussi éric

ça marche... maintenant il faut que je comprenne pourquoi... ça c'est autre chose.

Merci
11/07/2016, 14h14
patricktoulon

re

Alors c'est plus rapide ou pas ?????

Eric tu prendre l'exemplaire et l'essayer si tu veux ;)
11/07/2016, 19h13
eric4459

1 pièce(s) jointe(s)

Salut Patrick,
J'ai essayé ta macro en y ajoutant un compteur : Temps de traitement 147 sec pour 256 fichiers Csv
J'ai modifié la mienne pour prendre en compte le transfert de données Cvs (Passage de données avec séparateurs vers des colonnes multiples) : Temps de traitement 51 sec :)

Citation:

ca te donne une idée a quel point c'est rapide de: créer le fichier, le mettre 10 fois a jour en le fermant a chaque fois, et enfin l'ouvrir

beep beep!!!!!

Il est le problème avec mon code? ;)
Eric

Pièce jointe 215201
11/07/2016, 19h34
patricktoulon

1 pièce(s) jointe(s)

re

j'ai donc nettoyer tes deux sheets
changer le chemin qui correspondait au mien et ...

Pièce jointe 215202

rien ne se passe sauf une erreur

en plus il est impossible que workbooks.open blabla soit plus rapide que open for....
pour la simple et bonne raison qu'il n'y a pas d'interface
en plus tu utilise le FSO, en vba c'est seulement si c'est impossible autrement car il est très lourd
apres si le mien est plus long que prevu c'est parce que je ne me suis pas embêter avec les détails je boucle pour scinder le texte alors que je peut faire autrement
11/07/2016, 19h38
Marc-L

Bonjour,

juste en passant - je n'ai pas suivi cette discussion dans le détail - si vous voulez jouer côté célérité
le plus rapide pour un fichier texte est souvent d'utiliser ADODB.Stream …

_________________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …

re
oui marc j'y ai pensé mais déjà qu'il connaissent pas open for.... ca risque d'etre compliqué

eric j'ai fait sauter la boucle
teste ca avec tes fichiers adapte le chemin

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
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\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
            old_fichier = fichier
            tabl = Split(laChaine, vbCrLf) ' on coupe la chaine par les sauts de ligne
            f1 = Split(tabl(0), ";")(5) ' on recupere la F1
           If i = 0 Then texte = texte & tabl(1) & ";cellule F1" & vbCrLf ' on ajoute l'entete pour la colonne du F1 récupéré
             'ceci ci dessous ,remplace ma boucle sur les lignes
             texte = texte & Replace(Split(laChaine, tabl(1) & vbCrLf)(1), vbCrLf, ";" & f1 & vbCrLf) ' on garde que ce qu'il y a apres la ligne d'entete
             'et on ajoute le f1 a chaque ligne d'un coup avec replace sur le vbcrlf
 
        x2 = FreeFile
        Open fichier_final For Append As #x2 'on ouvre/reouvre le fichier en memoire
        Print #x, texte ' on y ajoute le texte
        Close #x ' on ferme le fichier et donc vide la memoire
        i = i + 1: texte = "" 'on vide la variable texte
        fichier = Dir ' on repart sur le dir du suivant
    Loop Until fichier = "" ' recommence jusqu'a que fichier = rien
    Workbooks.Open fichier_final, local:=True 'on ouvre le fichier final
End Sub

après on peut encore réduire le temps d'exécution
en réduisant le nombre de fois que l'on ajoute dans fichier final
en prenant un variable tableau par exemple et tout les 20 ou X on inscrit la compil

tiens

re
eric fait moi plaisir teste celui la
ca fait peur !!! moins de 3 seconde 319 fichier compilés !!!!!!!

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
 
Sub compil_csv()
    Dim fichier_final, fichier, x, x2, chemin, t
    fichier_final = "C:\Users\" & Environ("UserName") & "\Desktop\Fichierfinal.csv"
    If Dir(fichier_final) <> "" Then Kill fichier_final
    chemin = ThisWorkbook.Path
    fichier = Dir(ThisWorkbook.Path & "\*.csv")
    i = 0
    t = Time
    Do
        x = FreeFile
       fich = fich + 1
            Open chemin & "\" & fichier For Input As #x
            laChaine = Input(LOF(x), #x)
            Close #x
            old_fichier = fichier
            tabl = Split(laChaine, vbCrLf) ' on coupe la chaine par les sauts de ligne
            f1 = Split(tabl(0), ";")(5) ' on recupere la F1
           If i = 0 Then texte = texte & tabl(1) & ";cellule F1" & vbCrLf ' on ajoute l'entete pour la colonne du F1 récupéré
             'ceci ci dessous ,remplace ma boucle sur les lignes
             texte = texte & Replace(Split(laChaine, tabl(1) & vbCrLf)(1), vbCrLf, ";" & f1 & vbCrLf) ' on garde que ce qu'il y a apres la ligne d'entete
             'et on ajoute le f1 a chaque ligne d'un coup avec replace sur le vbcrlf
            txtfin = txtfin & texte
        i = i + 1: texte = "" 'on vide la variable texte
        fichier = Dir ' on repart sur le dir du suivant
    Loop Until fichier = "" ' recommence jusqu'a que fichier = rien
   x2 = FreeFile
        Open fichier_final For Append As #x2 'on ouvre/reouvre le fichier en memoire
        Print #x, txtfin ' on y ajoute le texte
        Close #x ' on ferme le fichier et donc vide la memoire
         Workbooks.Open fichier_final, local:=True 'on ouvre le fichier final
MsgBox "temps utilisé pour la compil  : " & Format(Time - t, "ss:nn") & vbCrLf & fich & " ont été compilés "
End Sub

2 pièce(s) jointe(s)

Salut Patrick,
J'ai fait un nouveau test avec mon code et il fonctionne correctement sur mon PC, j'ai essayé ton code et voici ce que j'obtiens , beaucoup plus rapide en effet :bravo:

Pièce jointe 215236

Mais le résultat n,etant pas celui attendu j'ai ajouté cela en fin de ton code
Code:

1 2 3 4 Columns(1).TextToColumns Destination:=Cells(1, 1), DataType:=xlDelimited, _ TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True
puis relancé pour ceci

Pièce jointe 215238

Bon y'a pas photo, chapeau bas, je m'incline :applo::applo::applo:
Je vais étudier cela en détail :merci:
Eric

Et 1,1 sec avec le code avec tableau :applo::applo::applo::applo::applo:

12/07/2016, 17h24
patricktoulon

re

Bonjour eric
c'est bizarre que tu soit obliger de séparer le code pour en faire des cellule après normalement le code csv n'est pas modifié

peut être a tu oublié local:=true a open non??

chez moi 509 fichier en 3.52 seconde c'est pour te dire !!!

après ta méthode est disons plus orthodoxe
mais ouvrir un classeur a la fois avec Excel tu imagine bien que ca met en branle tout le système office et donc tout ces évènements (calculate et compagnie)
12/07/2016, 18h40
eric4459

Salut Patrick,
J'ai séparé le code pour en faire des cellules car je pense que c'est ce que l'initiateur du post souhaitait

Citation:

Envoyé par CyberLudo

Bonjour,

Je vais essayer d'être clair dans ma demande :
J'ai sur un répertoire plus de 200 fichiers .csv. Ces fichiers sont tous constitués de la même façon :
- La première ligne constituée d'infos sur le fichier
- La deuxième ligne les entêtes de colonnes (12 colonnes utilisées)
- les lignes suivantes sont constituées des données (le nombre de lignes varie entre 2 et 1000)

Sinon, si j'ai bien compris ton code c'est

Code:

laChaine = Input(LOF(x), #x)

qui récupère toute les données du fichier en une seule fois, c'est bien ça?

Si oui, est-ce que l'on peut également utiliser cette méthode pour un fichier .xls au lieu de

Code:

Range("A3", "M" & NbLigne1).Copy 'On copie les données de la feuille

Eric
12/07/2016, 19h10
patricktoulon

re

oui mais pour faire un copy il faut ouvrir le csv en excel
moi non je l'ouvre pas je le met en mémoire et pour chaine c'est ca !!!