VBA Traitement plusieurs fichiers CSV vers regroupement en un tableau Excel

Le
LSteph
Bonjour à tous,
Je m'attarde sur la description ne pouvant fournir d'exemple(confidentialit=
é).

Contexte:
(Des fichiers qui arrivent d'un organisme externe de trésorerie dans u=
n format CSV au contenu un peu calamiteux.
Une dizaine de fichiers chaque mois sur une dizaine d'années de rÃ=
©férence pouvant être affectée chaque mois de recouvrement=
s etc divers.)

Importé dans Excel:

Les 16 premières lignes préfacent le contenu en un pavé te=
xte
La cellule [B6] contient la référence de l'année concernÃ=
©e 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és ains=
i sur des milliers de lignes

contenu type .";"";="52800";="NOGENT";="2701148412";="32719";==
"Particulier";="Personne physique";="1";.

1-Premier problème présence en plus ou en moins d'un " avec un =
; dans une chaine ou absence de signe =.
Moralité Cela décale tout dans certaines lignes lors de l'interpr=
étation.

Solution trouvée
supprimer tous les "=" via le bloc notes avec un Shell et SendKeys
du coup tout se met bien dans les cellules quand j'ouvre le fichier trait=
é.

2-Second problème non résolu
Si j'ouvre moi même un fichier (j'enregistre la macro) il s'ouvre comm=
e il faut.
Mais si j'exécute la macro ce n'est pas décompacté.

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ée puis pour les autres colonnes l'en-têtes (ligne 17 du=
1er CSV
en dessous répéter pour chaque enregistrement l'année situ=
ée en [b6] du csv
Puis les datas sous leurs en-têtes.

Soit les dix fichiers et eux seuls étant dans G:monrepCSVfich..
Le fichier Excel dans G:monrep..
Une seule macro pour Virer tous les signes =
Et Construire le tableau excel en bouclant sur les 10 csv
en virant les 16 premières lignes mais sans perdre l'année de r=
éf.

Dons si vous avez une idée de code pour boucler déjà correct=
ement l'ouverture des CSV

Merci d'avance.

--
LSteph
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #26398934
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")

Répertoire = "c:UsersMichDDocuments"
'*********************************************


Fichier = Dir(Répertoire & "*.csv")

X = FreeFile

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
Le #26398949
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")

Répertoire = "c:UsersMichDDocuments"
'*********************************************


Fichier = Dir(Répertoire & "*.csv")

X = FreeFile

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

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
'---------------------------------------------------------------
LSteph
Le #26399011
Bonjour,

merci j'ai essayé ce code
il s'exécute mais rien n'est copié dans le fichier excel
j'ai essayé avec f8
La boucle reste juste quelques tours dans le premier cas du Select Case
puis close et end sub

--
LSteph

Le jeudi 19 mai 2016 21:05:08 UTC+2, MichD a écrit :
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")

Répertoire = "c:UsersMichDDocuments"
'*********************************************


Fichier = Dir(Répertoire & "*.csv")

X = FreeFile

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

Line Input #1, WholeLine
'enlève les symboles "=" de la ligne
Temp = Replace(WholeLine, Exp2, Rempl)
'Place chaque section délimité par une vir gule
'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
'---------------------------------------------------------------
MichD
Le #26399019
Voici un exemple : http://www.cjoint.com/c/FEuleQwOs2X

C'est un fichier compressé comprenant 3 fichiers (Classeur1.xlsm + 2 fichiers textes)

Tu dézippes ce fichier et tu ouvres Excel à partir du répertoire où tu as dézippé ce fichier.

Exécute la macro et vois le résultat!

N.B. Dans les fichiers texte, j'ai tenté de reproduire la séquence des lignes à importer
selon la description que tu as faite de ces fichiers textes.

MichD
LSteph
Le #26399025
Re,
et merci je comprends mieux pourquoi...
la description que j'ai donnée correspond au csv lorsqu'on en ouvre un depuis excel!
Dans le bloc notes il y a une seule séquence de caractères qui oc cupe toute la largeur de la page et va jusqu'à la fin du fichier.
Ce qui se retrouve à la ligne 17 ouvert dans excel est à la ligne 5, 6, et le début de la 7 dans le bloc notes.

Ma difficulté est plus sur une ouverture correcte des csv avec distrib ution de colonnes que j'enregistre comme il faut mais que la macro ne resti tue pas. Workbooks.open Filename:="monfichier.csv"
Pour ce qui est du remplacement
Voici ce que je fais pour le moment:

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

End Sub

'LSteph

Le vendredi 20 mai 2016 13:09:01 UTC+2, MichD a écrit :
Voici un exemple : http://www.cjoint.com/c/FEuleQwOs2X

C'est un fichier compressé comprenant 3 fichiers (Classeur1.xlsm + 2 fichiers textes)

Tu dézippes ce fichier et tu ouvres Excel à partir du répe rtoire où tu as dézippé ce fichier.

Exécute la macro et vois le résultat!

N.B. Dans les fichiers texte, j'ai tenté de reproduire la séque nce des lignes à importer
selon la description que tu as faite de ces fichiers textes.

MichD
Publicité
Poster une réponse
Anonyme