VBA Traitement plusieurs fichiers CSV vers regroupement en un tableau Excel
5 réponses
LSteph
Bonjour =C3=A0 tous,
Je m'attarde sur la description ne pouvant fournir d'exemple(confidentialit=
=C3=A9).
Contexte:
(Des fichiers qui arrivent d'un organisme externe de tr=C3=A9sorerie dans u=
n format CSV au contenu un peu calamiteux.
Une dizaine de fichiers chaque mois sur une dizaine d'ann=C3=A9es de r=C3=
=A9f=C3=A9rence pouvant =C3=AAtre affect=C3=A9e chaque mois de recouvrement=
s etc divers.)
Import=C3=A9 dans Excel:
Les 16 premi=C3=A8res lignes pr=C3=A9facent le contenu en un pav=C3=A9 te=
xte
La cellule [B6] contient la r=C3=A9f=C3=A9rence de l'ann=C3=A9e concern=C3=
=A9e par le fichier.
La ligne 17 les entt de colonne
La ligne 18 est vide
A compter de la ligne 19 les datas qui dans le csv sont dispos=C3=A9s ains=
i sur des milliers de lignes
contenu type ....";"";=3D"52800";=3D"NOGENT";=3D"2701148412";=3D"32719";=3D=
"Particulier";=3D"Personne physique";=3D"1";....
=20
1-Premier probl=C3=A8me pr=C3=A9sence en plus ou en moins d'un " avec un =
; dans une chaine ou absence de signe =3D.
Moralit=C3=A9 Cela d=C3=A9cale tout dans certaines lignes lors de l'interpr=
=C3=A9tation.
Solution trouv=C3=A9e=20
supprimer tous les "=3D" via le bloc notes avec un Shell et SendKeys
du coup tout se met bien dans les cellules quand j'ouvre le fichier trait=
=C3=A9.
2-Second probl=C3=A8me non r=C3=A9solu
Si j'ouvre moi m=C3=AAme un fichier (j'enregistre la macro) il s'ouvre comm=
e il faut.
Mais si j'ex=C3=A9cute la macro ce n'est pas d=C3=A9compact=C3=A9.
3-Objectif en VBA faire un seul tableau excel en feuil1
Boucler sur les dix fichiers CSV en mettant dans le fichier Excel
en A1 Ann=C3=A9e puis pour les autres colonnes l'en-t=C3=AAtes (ligne 17 du=
1er CSV
en dessous r=C3=A9p=C3=A9ter pour chaque enregistrement l'ann=C3=A9e situ=
=C3=A9e en [b6] du csv
Puis les datas sous leurs en-t=C3=AAtes.
Soit les dix fichiers et eux seuls =C3=A9tant dans G:\monrep\CSVfich\..
Le fichier Excel dans G:\monrep\..
Une seule macro pour Virer tous les signes =3D
Et Construire le tableau excel en bouclant sur les 10 csv=20
en virant les 16 premi=C3=A8res lignes mais sans perdre l'ann=C3=A9e de r=
=C3=A9f.
Dons si vous avez une id=C3=A9e de code pour boucler d=C3=A9j=C3=A0 correct=
ement l'ouverture des CSV
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Essaie comme ceci :
'----------------------------------------------------- Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String Dim Fichier As String, X As Long, B As Long Dim Exp2 As String, Sep As String Dim Rempl As String, Rg As Range, A As Long Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************ Exp2 = "=" 'L'expression à remplacer Rempl = "" ' Remplacer par rien Sep = ";" 'séparateur d'élément dans le fichier .csv
Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Application.ScreenUpdating = False Application.EnableEvents = False Do While Fichier <> "" Open Répertoire & Fichier For Input Access Read As #X While Not EOF(X) A = A + 1 Select Case A Case 1 To 16, 18 Line Input #1, WholeLine 'pour ces lignes, on ne retient rien Case Else B = B + 1 Line Input #1, WholeLine 'enlève les symboles "=" de la ligne Temp = Replace(WholeLine, Exp2, Rempl) 'Place chaque section délimité par une virgule 'dans le tableau T T = Split(Temp, Sep) 'Copie le contenu de T dans Excel Rg(B).Resize(, UBound(T) + 1) = T End Select Wend Close #X Temp = "": A = 0 Fichier = Dir() Loop 'enlève les "" dans la plage résultat With Rg.CurrentRegion .Replace """", "", LookAt:=xlPart End With Application.ScreenUpdating = True Application.EnableEvents = True
End Sub '-----------------------------------------------------
MichD
Bonjour,
Essaie comme ceci :
'-----------------------------------------------------
Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String
Dim Fichier As String, X As Long, B As Long
Dim Exp2 As String, Sep As String
Dim Rempl As String, Rg As Range, A As Long
Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************
Exp2 = "=" 'L'expression à remplacer
Rempl = "" ' Remplacer par rien
Sep = ";" 'séparateur d'élément dans le fichier .csv
Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While Fichier <> ""
Open Répertoire & Fichier For Input Access Read As #X
While Not EOF(X)
A = A + 1
Select Case A
Case 1 To 16, 18
Line Input #1, WholeLine
'pour ces lignes, on ne retient rien
Case Else
B = B + 1
Line Input #1, WholeLine
'enlève les symboles "=" de la ligne
Temp = Replace(WholeLine, Exp2, Rempl)
'Place chaque section délimité par une virgule
'dans le tableau T
T = Split(Temp, Sep)
'Copie le contenu de T dans Excel
Rg(B).Resize(, UBound(T) + 1) = T
End Select
Wend
Close #X
Temp = "": A = 0
Fichier = Dir()
Loop
'enlève les "" dans la plage résultat
With Rg.CurrentRegion
.Replace """", "", LookAt:=xlPart
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'-----------------------------------------------------
'----------------------------------------------------- Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String Dim Fichier As String, X As Long, B As Long Dim Exp2 As String, Sep As String Dim Rempl As String, Rg As Range, A As Long Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************ Exp2 = "=" 'L'expression à remplacer Rempl = "" ' Remplacer par rien Sep = ";" 'séparateur d'élément dans le fichier .csv
Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Application.ScreenUpdating = False Application.EnableEvents = False Do While Fichier <> "" Open Répertoire & Fichier For Input Access Read As #X While Not EOF(X) A = A + 1 Select Case A Case 1 To 16, 18 Line Input #1, WholeLine 'pour ces lignes, on ne retient rien Case Else B = B + 1 Line Input #1, WholeLine 'enlève les symboles "=" de la ligne Temp = Replace(WholeLine, Exp2, Rempl) 'Place chaque section délimité par une virgule 'dans le tableau T T = Split(Temp, Sep) 'Copie le contenu de T dans Excel Rg(B).Resize(, UBound(T) + 1) = T End Select Wend Close #X Temp = "": A = 0 Fichier = Dir() Loop 'enlève les "" dans la plage résultat With Rg.CurrentRegion .Replace """", "", LookAt:=xlPart End With Application.ScreenUpdating = True Application.EnableEvents = True
End Sub '-----------------------------------------------------
MichD
MichD
Une petite retouche afin d'éviter que la ligne de titre des colonnes de chacun des fichiers s'insèrent dans le tableau des résultats.
'--------------------------------------------------------------- Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String Dim Fichier As String, X As Long, B As Long Dim Exp2 As String, Sep As String, C As Long Dim Rempl As String, Rg As Range, A As Long Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************ Exp2 = "=" 'L'expression à remplacer Rempl = "" ' Remplacer par rien Sep = ";" 'séparateur d'élément dans le fichier .csv
'Adapter le nom du classeur, celui de la feuille de résultat et 'l'adresse de la première cellule du coin supérieur gauche où doivent 's'insérer les données dans la feuille résultat. Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Do While Fichier <> "" Open Répertoire & Fichier For Input Access Read As #X While Not EOF(X) A = A + 1 Select Case A Case 1 To 16, 18 Line Input #1, WholeLine 'pour ces lignes, on ne retient rien Case Else
Line Input #1, WholeLine 'enlève les symboles "=" de la ligne Temp = Replace(WholeLine, Exp2, Rempl) 'Place chaque section délimité par une virgule 'dans le tableau T T = Split(Temp, Sep) 'Copie le contenu de T dans Excel If A = 17 And C = 0 Then B = B + 1 Rg(B).Resize(, UBound(T) + 1) = T C = 1 ElseIf A <> 17 And C = 1 Then B = B + 1 Rg(B).Resize(, UBound(T) + 1) = T End If End Select Wend Close #X Temp = "": A = 0: C = 1 Fichier = Dir() Loop 'enlève les "" dans la plage résultat With Rg.CurrentRegion .Replace """", "", LookAt:=xlPart End With Application.ScreenUpdating = True Application.EnableEvents = True
End Sub '---------------------------------------------------------------
Une petite retouche afin d'éviter que la ligne de titre des colonnes de
chacun des fichiers s'insèrent dans le tableau des résultats.
'---------------------------------------------------------------
Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String
Dim Fichier As String, X As Long, B As Long
Dim Exp2 As String, Sep As String, C As Long
Dim Rempl As String, Rg As Range, A As Long
Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************
Exp2 = "=" 'L'expression à remplacer
Rempl = "" ' Remplacer par rien
Sep = ";" 'séparateur d'élément dans le fichier .csv
'Adapter le nom du classeur, celui de la feuille de résultat et
'l'adresse de la première cellule du coin supérieur gauche où doivent
's'insérer les données dans la feuille résultat.
Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Do While Fichier <> ""
Open Répertoire & Fichier For Input Access Read As #X
While Not EOF(X)
A = A + 1
Select Case A
Case 1 To 16, 18
Line Input #1, WholeLine
'pour ces lignes, on ne retient rien
Case Else
Line Input #1, WholeLine
'enlève les symboles "=" de la ligne
Temp = Replace(WholeLine, Exp2, Rempl)
'Place chaque section délimité par une virgule
'dans le tableau T
T = Split(Temp, Sep)
'Copie le contenu de T dans Excel
If A = 17 And C = 0 Then
B = B + 1
Rg(B).Resize(, UBound(T) + 1) = T
C = 1
ElseIf A <> 17 And C = 1 Then
B = B + 1
Rg(B).Resize(, UBound(T) + 1) = T
End If
End Select
Wend
Close #X
Temp = "": A = 0: C = 1
Fichier = Dir()
Loop
'enlève les "" dans la plage résultat
With Rg.CurrentRegion
.Replace """", "", LookAt:=xlPart
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'---------------------------------------------------------------
Une petite retouche afin d'éviter que la ligne de titre des colonnes de chacun des fichiers s'insèrent dans le tableau des résultats.
'--------------------------------------------------------------- Sub Tous_Les_Fichiers_CSV_Dun_Répertoire()
Dim Chemin As String, Temp As String Dim Fichier As String, X As Long, B As Long Dim Exp2 As String, Sep As String, C As Long Dim Rempl As String, Rg As Range, A As Long Dim Répertoire As String, WholeLine As String
'*********VARIABLES À RENSEIGNER************ Exp2 = "=" 'L'expression à remplacer Rempl = "" ' Remplacer par rien Sep = ";" 'séparateur d'élément dans le fichier .csv
'Adapter le nom du classeur, celui de la feuille de résultat et 'l'adresse de la première cellule du coin supérieur gauche où doivent 's'insérer les données dans la feuille résultat. Set Rg = Workbooks(ThisWorkbook.Name).Worksheets("Feuil1").Range("A1")
Do While Fichier <> "" Open Répertoire & Fichier For Input Access Read As #X While Not EOF(X) A = A + 1 Select Case A Case 1 To 16, 18 Line Input #1, WholeLine 'pour ces lignes, on ne retient rien Case Else
Line Input #1, WholeLine 'enlève les symboles "=" de la ligne Temp = Replace(WholeLine, Exp2, Rempl) 'Place chaque section délimité par une virgule 'dans le tableau T T = Split(Temp, Sep) 'Copie le contenu de T dans Excel If A = 17 And C = 0 Then B = B + 1 Rg(B).Resize(, UBound(T) + 1) = T C = 1 ElseIf A <> 17 And C = 1 Then B = B + 1 Rg(B).Resize(, UBound(T) + 1) = T End If End Select Wend Close #X Temp = "": A = 0: C = 1 Fichier = Dir() Loop 'enlève les "" dans la plage résultat With Rg.CurrentRegion .Replace """", "", LookAt:=xlPart End With Application.ScreenUpdating = True Application.EnableEvents = True
End Sub '---------------------------------------------------------------
Sub SupCarbloc(monfichier As String, machaine As String) 'utilise le blocnote pour supprimer un chr dans un fichier myap = "notepad " & monfichier ident = Shell(myap, vbNormalFocus) SendKeys "^h" SendKeys machaine SendKeys "%t{ESC}^s%{F4}" End Sub Sub Suptout() Dim f As String ChDrive "G:" ChDir "G:TraiterarCSVin" f = Dir("*.csv") Do While Len(f) > 0 Call SupCarbloc(f, "=") Application.Wait Now + TimeValue("00:00:03") Call SupCarbloc(f, Chr(34)) Application.Wait Now + TimeValue("00:00:03") f = Dir Loop
Sub SupCarbloc(monfichier As String, machaine As String)
'utilise le blocnote pour supprimer un chr dans un fichier
myap = "notepad " & monfichier
ident = Shell(myap, vbNormalFocus)
SendKeys "^h"
SendKeys machaine
SendKeys "%t{ESC}^s%{F4}"
End Sub
Sub Suptout()
Dim f As String
ChDrive "G:"
ChDir "G:TraiterarCSVin"
f = Dir("*.csv")
Do While Len(f) > 0
Call SupCarbloc(f, "=")
Application.Wait Now + TimeValue("00:00:03")
Call SupCarbloc(f, Chr(34))
Application.Wait Now + TimeValue("00:00:03")
f = Dir
Loop
Sub SupCarbloc(monfichier As String, machaine As String) 'utilise le blocnote pour supprimer un chr dans un fichier myap = "notepad " & monfichier ident = Shell(myap, vbNormalFocus) SendKeys "^h" SendKeys machaine SendKeys "%t{ESC}^s%{F4}" End Sub Sub Suptout() Dim f As String ChDrive "G:" ChDir "G:TraiterarCSVin" f = Dir("*.csv") Do While Len(f) > 0 Call SupCarbloc(f, "=") Application.Wait Now + TimeValue("00:00:03") Call SupCarbloc(f, Chr(34)) Application.Wait Now + TimeValue("00:00:03") f = Dir Loop
