Discussion :

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

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

[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

[CyberLudo]

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

[eric4459]

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 :

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

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

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
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
Fichier Recap.xlsm
Eric

[eric4459]

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

Code :

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

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

J'ai egalement ajouté ceci:

Code :

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

Application.ScreenUpdating = False

et

Code :

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

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 :

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

Fichier Recap.xlsm


Eric

[patricktoulon]

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

[eric4459]

Bonjour Patrick

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

Eric

[patricktoulon]

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

Code :

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

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

[patricktoulon]

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

Code :

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

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 :

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

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

[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

[CyberLudo]

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"

[patricktoulon]

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

Code :

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

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

donne moi deux fichiers bidon remplissant tes critères je te fait un exemple

[CyberLudo]

En PJ je t'ai mis les deux premiers fichiers de ma série. Il sont en Xls mais normalement c'est du CSV

[patricktoulon]

ok je prends
dis moi quelle cellule tu veux récupérer pour la mettre a la fin

[Marc-L]

Bonjour, bonjour !

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

Voilà, voilà !

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

[CyberLudo]

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

[patricktoulon]

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

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

[patricktoulon]

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 :

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

[patricktoulon]

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 :

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

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