création automique de fichier CSV par ligne du fichier d'origine

[surgeon84fr]

Bonjour au forum et tous les super-spécialistes de la macro.

Je reviens vers vous avec un nouveau besoin.

Je joins un fichier test au format XSLX. Mais au départ ce fichier est une extraction de base de donnée au format CSV que je ne peux pas joindre.
J'ai volontairement laissé pleine la colonne avec laquelle le test doit être fait. Dans cette colonne, il arrivera qu'un code revienne plus bas dans cette même colonne...

Mon besoin est qu'il faudrait que je crée à partir de mon fichier CSV, un nouveau fichier CSV par ligne de ce fichier test (ligne d'en-têtes conservée), soit un nouveau fichier CSV (séparé par point-virgule) comprenant la ligne d'en-tête telle que dans le fichier d'origine et une seule ligne dessous dont le code de la colonne 4 doit n'être utilisé qu'une fois.

Je ne sais pas si je suis bien clair.

En gros, s'il y a 1000 codes DIFFERENTS dans la colonne D, il y aura 1000 fichier CSV avec la ligne d'en-tête et celle recopiée du CSV de départ.

En vous remerciant d'avance pour votre généreuse contribution.

 

[camarchepas]

Re : création automique de fichier CSV par ligne du fichier d'origine

Bonjour ,
Bon , l'on va faire un petit cas d'école,
il faut plus de la méthode que de la haut voltige en vba pour ce sujet

Voici comment je m'y prendrais :

Calcul de la derniére ligne utilisée de la colonne D
Tri sur la colonne D , ça peu pas faire de mal afin d'être sur d'avoir les références identiques les une derriere les autres.
Mémorisation des entêtes dans un tableau.
Boucle de parcours de l'ensemble des lignes dans laquelle :
Test du code colonne D, si déjà vu si oui , reprend la boucle pour lire la valeur suivante
si non :
Construction des chaines partielles avec des ; pour les données avant et aprés la colonne D
construction de la chaine données et uitilisant les chaines partielles et la valeur de la colonne D de la ligne actuelle
mise en mémoire de la valeur trouvée dans colonne D
Construction du chemin cible ??? : si non précisé , ce sera c:\temp à adapter ultérieurement
Construction du nom du Csv , si non précisé sera "Fiche_" + code colonne D
Ouverture d'un fichier en écriture
écrture de la ligne entéte et données dans le fichier
fermeture du fichier csv
passage à la ligne suivante ou sortie de boucle si ligne courante supérieure à ligne max
message fin de traitement Ok

Voilà
qu'en penses -tu ?

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

wouaouh!!!
Expliqué comme ça, ça a l'air simple....
L'idée de trier au départ, j'y avais pensé et ce n'est pas le plus difficile. AU pire, j'aurai enregistré la macro en live.

Mais pour le reste, même si dans ma tête j'avais pensé à ça, avec es conniassances actuelles, je ne sais pas comment l'écrire...

C'est gentil de m'aiguiller quand même...

Je tente un début de procédure et je reviens....Je ne suis pas contre un coup de pouce....

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Re bonjour

voici le début:

Sub SAVECSV()

Dim derlig&, dercol%, t1, colref%, t2(), i&, n&, j&, k%

t = Timer 'pour chronométrer

nomfeuil = ActiveSheet.Name 'nom de la feuille active
nomclasseur1 = ActiveWorkbook.Name 'nom du classeur actif

With Sheets(nomfeuil)
derlig = .Cells(.Rows.Count, 1).End(xlUp).Row 'dernière ligne
dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column 'dernière colonne
t1 = .[a1].Resize(1, dercol) 'ligne d'en-tête mémorisée dans tableau t1
colref = Application.Match("Code CREDO bénéficiaire", .[1:1], 0) 'référence de la colonne contenant les codes
End With

ActiveWorkbook.Worksheets(nomfeuil).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(nomfeuil).Sort.SortFields.Add _
Key:=Range(Cells(2, colref), Cells(derlig, colref)), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers

With ActiveWorkbook.Worksheets(nomfeuil).Sort
.SetRange Range([a1].End(xlDown), [a1].End(xlToRight))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Re.

Je reviens avec un code "presque" complet

Celui -ci est sûrement améliorable mais à mon niveau si ça marche, je ne sais plus optimiser...
Bref...voici mon code:

Sub SAVECSV()
'***************variables**************************
Dim derlig&, dercol%, colref%, colref2%, colref3%, colref4%, t1, t2, i&, cod1$, cod2$, j&
Dim colcode As Range
'**************************************************
'***************timer*******************************
t = Timer 'pour chronométrer
'**************************************************
'**************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'**************************************************
'**************************************************
nomfeuil = ActiveSheet.Name 'nom de la feuille active
nomclasseur1 = ActiveWorkbook.Name 'nom du classeur actif
chemin = ActiveWorkbook.Path
fich = Dir(chemin & "\*.csv")
'**************************************************
'**************************************************
With Sheets(nomfeuil)
derlig = .Cells(.Rows.Count, 1).End(xlUp).Row 'dernière ligne
dercol = .Cells(2, .Columns.Count).End(xlToLeft).Column 'dernière colonne
t1 = .[A1].Resize(1, dercol) 'ligne d'en-tête mémorisée dans tableau t1
colref = Application.Match("Code CREDO bénéficiaire", .[1:1], 0) 'référence de la colonne contenant les codes
colref2 = Application.Match("Code CREDO livraison", .[1:1], 0) 'référence de la colonne contenant les codes 2
colref3 = Application.Match("Prix estimé de la FEB", .[1:1], 0) 'référence de la colonne contenant les prix
colref4 = Application.Match("date modification", .[1:1], 0) 'référence de la colonne contenant les dates
End With
Set colcode = Worksheets(nomfeuil).Range(Cells(1, colref), Cells(derlig, colref))
'**************************************************
'*********TRI SUR COLONNE [colref]*****************
ActiveWorkbook.Worksheets(nomfeuil).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(nomfeuil).Sort.SortFields.Add _
Key:=Range(Cells(2, colref), Cells(derlig, colref)), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers

With ActiveWorkbook.Worksheets(nomfeuil).Sort
.SetRange Range([A1].End(xlDown), [A1].End(xlToRight))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'**************************************************
'**************************************************
With Sheets(nomfeuil)
t2 = .[D2].Resize(derlig - 1, 1) 'colonne des codes mémorisée dans tableau t2
End With
'**************************************************

'************Définition BOUCLE*********************
cod2 = ""
j = 0 ' la boucle doit s'arrêter lorsque 50 fichiers auront été créés. On commence par mettre le compteur à zéro

For i = 1 To derlig - 1
cod1 = t2(i, 1)

lignacopier = colcode.Find(cod1).Row 'numéro de la ligne à copier en dessous des en-têtes

If cod1 <> cod2 Then

If j = 50 Then GoTo 11000 'on arrête la boucle dès que 50 fichiers ont été créés

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
nomclasseur2 = ActiveWorkbook.Name
nomfeuil2 = ActiveSheet.Name
cod2 = cod1
j = j + 1
Else: GoTo 10000

End If
'**************************************************
Windows(nomclasseur1).Activate
Rows(lignacopier).EntireRow.Copy
'**************************************************
'**************************************************
Windows(nomclasseur2).Activate
With Sheets(nomfeuil2)
.[A1].Resize(1, dercol) = t1
.[a2].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
'**************************************************
'********FORMATAGE DES COLONNES du FICHIER n°2*****
Columns(colref).NumberFormat = "@" 'format texte pour une bonne recopie du code
Columns(colref2).NumberFormat = "@" 'format texte pour une bonne recopie du code 2
Columns(colref3).NumberFormat = "#,##0.00 $" 'format des prix
Columns(colref4).NumberFormat = "m/d/yyyy h:mm" 'format de la date
'**************************************************
'********SAUVE en CONSERVANT le format CSV*********
ActiveWorkbook.SaveAs Filename:=chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
ActiveWorkbook.Close SaveChanges:=False
'**************************************************
'***********RETOUR AU CLASSEUR DE DEPART***********
Windows(nomclasseur1).Activate
'**************************************************
10000
cod2 = cod1
Next i
'***************FIN DE LA BOUCLE*******************

11000
'**************************************************
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'**************************************************
'**************AFFICHAGE du TIMER******************
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
'**************************************************

End Sub

Il me reste un souci et j'ai cherché partout mais ne comprends pas:

Les code sont du type "01E0000". Forcément le "E" est interprété comme un format scientifique en EXPOSANT.

Malgré mes lignes pour forcer le formatage des colonnes, lorsque je réouvre mon fichier, je me retrouve avec une cellule "1,00E+00", et les code du type "0535000" perdent leur premier "0" et se transforment en "535000"

Merci pour votre aide.

Désolé pour les couleurs mais j'ai pensé que visuellement ce serait plus facile.

 

[camarchepas]

Re : création automique de fichier CSV par ligne du fichier d'origine

Surgeon ,

Cela fait plaisir de voir que tu as pris le taureau par les cornes .

Je regarderai en soirée en détaille ce que tu as fais , bien sur tout est améliorable , il faut le temps et la pratique .


Pour le problème de format , il faut forcer ta cellule en texte avant de mettre la valeur et là ça doit fonctionner .

je reprendrais ton fichier de départ pour faire les tests .

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Merci de prendre le temps.

Cdlt.

 

[camarchepas]

Re : création automique de fichier CSV par ligne du fichier d'origine

Bonjour ,

Donc quelques petites choses qui ne fonctionnaient pas .
Voici une optimisation de ton code sans modifier la conception de base.

Attention au déclaration des variables il en manquait quelques unes ,
utilises Option explicit qui t'obliges à les déclarer ( ça évite de chercher pendant des heures pourquoi cela ne marche pas : la variable etoile est différente de la variable étoile par exemple)

Option Explicit
Sub SAVECSV()
'***************variables************************* *
Dim derlig&, dercol%, colref%, colref2%, colref3%, colref4%, t1, t2, i&, cod1$, cod2$, j&
Dim colcode As Range
Dim NomFeuil1$, NomClasseur1$, NomFeuil2$, NomClasseur2$, Chemin$, Fich$
Dim LignACopier%, T&
'***************timer***************************** *
T = Timer 'pour chronométrer
'************************************************* *
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'************************************************* *
NomFeuil1 = ActiveSheet.Name 'nom de la feuille active
NomClasseur1 = ActiveWorkbook.Name 'nom du classeur actif
Chemin = ActiveWorkbook.Path
'************************************************* *
With Sheets(NomFeuil1)
  colref = Application.Match("Code CREDO bénéficiaire", .[1:1], 0) 'référence de la colonne contenant les codes
  colref2 = Application.Match("Code CREDO livraison", .[1:1], 0) 'référence de la colonne contenant les codes 2
  colref3 = Application.Match("Prix estimé de la FEB", .[1:1], 0) 'référence de la colonne contenant les prix
  colref4 = Application.Match("date modification", .[1:1], 0) 'référence de la colonne contenant les dates
  derlig = .Cells(.Rows.Count, colref).End(xlUp).Row 'dernière ligne
  dercol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'dernière colonne
  t1 = .[A1].Resize(1, dercol) 'ligne d'en-tête mémorisée dans tableau t1
  Set colcode = .Range(Cells(1, colref), Cells(derlig, colref))
End With

'*********TRI SUR COLONNE [colref]*****************
    Columns(colref).NumberFormat = "@"

    With Worksheets(NomFeuil1).Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Chr(64 + colref) & "1:" & Chr(64 + colref) & derlig) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Cells(1, 1), Cells(derlig, dercol))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'************************************************* *

t2 = Sheets(NomFeuil1).Range(Chr(64 + colref) & 2).Resize(derlig - 1, 1) 'colonne des codes mémorisée dans tableau t2

************Définition BOUCLE*********************
cod2 = ""
j = 0 ' la boucle doit s'arrêter lorsque 50 fichiers auront été créés. On commence par mettre le compteur à zéro

For i = 1 To derlig - 1
   
   cod1 = t2(i, 1)
   LignACopier = colcode.Find(cod1).Row 'numéro de la ligne à copier en dessous des en-têtes
   
   If cod1 <> cod2 Then
     If j >= 50 Then Exit For 'on arrête la boucle dès que 50 fichiers ont été créés
     Workbooks.Add
     ActiveWorkbook.SaveAs Filename:=Chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
     NomClasseur2 = ActiveWorkbook.Name
     NomFeuil2 = ActiveSheet.Name
     cod2 = cod1
     j = j + 1

     With Workbooks(NomClasseur2).Sheets(NomFeuil2)
      .[A1].Resize(1, dercol) = t1
      Workbooks(NomClasseur1).Sheets(NomFeuil1).Rows(LignACopier).EntireRow.Copy Destination:=.[A2].Resize(1, dercol)

      '********FORMATAGE DES COLONNES du FICHIER n°2*****
      .Columns(colref).NumberFormat = "@" 'format texte pour une bonne recopie du code
      .Columns(colref2).NumberFormat = "@" 'format texte pour une bonne recopie du code 2
      .Columns(colref3).NumberFormat = "#,##0.00 $" 'format des prix
      .Columns(colref4).NumberFormat = "m/d/yyyy h:mm" 'format de la date
     End With
     
    '********SAUVE en CONSERVANT le format CSV*********
     Workbooks(NomClasseur2).SaveAs Filename:=Chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
     Workbooks(NomClasseur2).Close SaveChanges:=False
   
   End If

Next i

'***********RETOUR AU CLASSEUR DE DEPART***********
 Workbooks(NomClasseur1).Activate

'***************FIN DE LA BOUCLE*******************
Application.ScreenUpdating = True
Application.DisplayAlerts = True

'**************AFFICHAGE du TIMER******************
MsgBox "Durée " & Format(Timer - T, "0.0 \s")

End Sub

 

[job75]

Re : création automique de fichier CSV par ligne du fichier d'origine

Bonjour surgeon, camarchepas,

Mais au départ ce fichier est une extraction de base de donnée au format CSV que je ne peux pas joindre.

Et pourquoi donc ???

Dans le dossier zip ci-joint extraire les 2 fichiers dans le même dossier (le bureau par exemple).

Ouvrir le fichier "Création des fichiers CSV(1).xlsm" et cliquer sur le bouton pour lancer cette macro :

Sub FichiersCSV()
Dim chemin$, nomfich$, dossier$, d As Object, c As Range
chemin = ThisWorkbook.Path & "\"
nomfich = "SourceCSV.csv" 'à adapter
dossier = "Fichiers CSV\" 'dossier réceptacle
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
MkDir chemin & dossier 'création du dossier s'il n'existe pas
With Workbooks.Open(chemin & nomfich).Sheets(1)
  Workbooks.Add 'nouveau document
  .Rows(1).Copy [A1]
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In .[A:A].SpecialCells(xlCellTypeConstants)
    If c.Row > 1 And Not d.exists(c.Value) Then
      d(c.Value) = ""
      [A2] = c
      ActiveWorkbook.SaveAs chemin & dossier & Replace(c, ";", ""), xlCSV
    End If
  Next
  ActiveWorkbook.Close False
  .Parent.Close False
End With
End Sub

Les fichiers CSV se créent dans le sous-dossier "Fichiers CSV".

Cela prendra du temps (plus de 19000 lignes à traiter [Edit] et 2294 fichiers créés)

Edit : sur Win 7 - Excel 2010 la durée d'exécution est fe 7 minutes 26 secondes.

A+

 

[job75]

Re : création automique de fichier CSV par ligne du fichier d'origine

Re,

Juste une précision pour bien comprendre ma macro.

Quand on ouvre manuellement le fichier "SourceCSV.csv" on obtient un fichier Excel avec les données en colonne D.

Mais quand on l'ouvre par VBA toutes les données sont en colonne A avec des points-virgules.

Pour s'en convaincre mettre un End dans la macro et lancez-la :

'---
With Workbooks.Open(chemin & nomfich).Sheets(1)
End
'----

A+

 

[job75]

Re : création automique de fichier CSV par ligne du fichier d'origine

Re,

2 compléments dans cette version (2) :

- un "timer" dans la macro pour mesurer la durée d'exécution

- surtout j'ai mis la colonne D du fichier "SourceCSV.csv" au format "Standard" pour éliminer les formats "Scientifique".

Edit : il y a maintenant 22298 fichiers créés (4 de plus).

A+

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Bonjour à tous.

Pour job75, ce que je voulais dire, c'est que sur le forum, je ne peux pas joindre de fichier CSV à mon post

Par contre, pour la création, j'ai stoppé la boucle à 50 fichiers CSV créés, parce qu'en effet, ça peut durer longtemps!!!!

Pour camarchepas, ça marche nickel!!!

Merci pour ces petits changements efficaces. Par contre je ne comprends pas l'ajout du chr(64). Ca change le résultat du triage.

Merci à tous les deux pour vos interventions.

Bien cordialement!!

Et bonne continuation

 

[job75]

Re : création automique de fichier CSV par ligne du fichier d'origine

Pour job75, ce que je voulais dire, c'est que sur le forum, je ne peux pas joindre de fichier CSV à mon post

Ben si, il suffisait de zipper le fichier...

Par ailleurs je n'ai pas l'impression que vous ayez testé mes solutions.

Tant pis pour vous 7 minutes pour 2298 fichiers ce n'est pas la mer à boire....

A bientôt peut-être.

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Je ne voulais pas vous vexer....

Je vais la tester sur mon besoin: 50 fichiers

Cdlt.

 

[surgeon84fr]

Re : création automique de fichier CSV par ligne du fichier d'origine

Rebonjour

Pour job75:

j'ai testé avec une adaptation puisque le fichier que j'ouvre a toutes ses colonnes remplies et un autre nom.
Ca ne marche plus....

En fait ça n'enregistre que 4 fichiers puis stop....

J'ai essayé de comprendre mais n'y suis pas arrivé.

C'est sûr : on voit celui qui a de l'expérience....et moi....Il y a une sacré différence de longueur.....dans la macro.