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

surgeon84fr · 6 Octobre 2014

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.

job75 · 8 Octobre 2014

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

Re,

surgeon à dit:
le fichier que j'ouvre a toutes ses colonnes remplies et un autre nom.

En effet avec toutes les colonnes remplies ma solution ne peut pas fonctionner telle quelle.

Joignez donc votre fichier.

A+

job75 · 8 Octobre 2014

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

Re,

Bon, cette macro fonctionnera même si d'autres colonnes que la colonne D sont remplies :

Code:

Sub FichiersCSV()
Dim t#, chemin$, nomfich$, dossier$, d As Object, c As Range, x
t = Timer
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)
    x = Split(c, ";")(3)
    If c.Row > 1 And Not d.exists(x) Then
      d(x) = ""
      [A2] = ";;;" & x
      ActiveWorkbook.SaveAs chemin & dossier & x, xlCSV
    End If
  Next
  ActiveWorkbook.Close False
  .Parent.Close False
End With
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
End Sub

Bien sûr le fichier source doit être un fichier .csv, entrez son nom en 5ème ligne de la macro.

A+

surgeon84fr · 8 Octobre 2014

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

Re

1)je joints mon fichier pour tester la macro en cours

2)Je souhaiterai faire une deuxième macro qui ferait presque la même chose à la différence que:

-la ligne d'en-tête est toujours recopiée dans un nouveau CSV
-ce n'est plus une ligne par code, mais autant de lignes recopiées que le code revient dans la même colonne des codes du fichier d'origine.
-sauvegarder les nouveaux fichiers en CSV (comme précédemment) à concurrence de 25 même s'il y a plus que 25 codes.

Merci d'avance.

job75 · 8 Octobre 2014

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

Re,

Je me suis limité au point 1) :

- j'ai mis la macro du post #17 dans le fichier .xlsm

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

La macro a créé 2189 fichiers .csv en 5 minutes 51 secondes sur Win 7 - Excel 2010.

Dossier (3).zip joint.

Pour le point 2) je verrai plus tard, si j'ai le temps.

A+

surgeon84fr · 8 Octobre 2014

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

Bonsoir

je ne comprends pas pourquoi ça ne copie que le code et non la ligne entière?

bonne nuit

job75 · 8 Octobre 2014

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

surgeon à dit:
je ne comprends pas pourquoi ça ne copie que le code et non la ligne entière?

Il suffisait de dire clairement ce que vous vouliez.

Donc remplacer :

Code:

[A2] = ";;;" & x

par :

Code:

[A2] = c

A+

job75 · 8 Octobre 2014

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

Re,

Voici la 2ème macro que vous avez demandée :

Code:

Sub FichiersCSV_25_premiers()
Dim t#, N&, chemin$, nomfich$, dossier$, d As Object
Dim c As Range, x, lig&, c1 As Range
t = Timer
N = 25 'nombre maximum de fichiers à créer
chemin = ThisWorkbook.Path & "\"
nomfich = "test.csv" 'à adapter
dossier = "Fichiers CSV 25 premiers\" '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)
    x = Split(c, ";")(3)
    If c.Row > 1 And Not d.exists(x) Then
      d(x) = ""
      Range("A2:A" & Rows.Count).ClearContents 'RAZ
      lig = 2
      For Each c1 In .[A:A].SpecialCells(xlCellTypeConstants)
        If Split(c1, ";")(3) = x Then
          Cells(lig, 1) = c1
          lig = lig + 1
        End If
      Next
      ActiveWorkbook.SaveAs chemin & dossier & x, xlCSV
      If d.Count = N Then Exit For
    End If
  Next
  ActiveWorkbook.Close False
  .Parent.Close False
End With
MsgBox "Durée " & Format(Timer - t, "0.0 \s")
End Sub

Elle crée les 25 fichiers en 13 secondes.

Fichier (4).zip joint, le fichier .xlsm contient bien sûr les 2 macros.

Bonne nuit.

surgeon84fr · 9 Octobre 2014

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

Bonjour à tous

Merci beaucoup job75 d'avoir pris le temps si tard!!

J'ai récupéré le zip.

Je regarde tout de suite et reviens vite

cdlt

surgeon84fr · 9 Octobre 2014

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

Bonjour job75, le forum

Je n'aime pas déranger, mais j'ai encore un souci.

J'ai bien vu dès le début que le format de ma colonne était mis sur standard. Je pensais moi aussi que c'était la solution.

Pourtant, quand j'ouvre mon CSV créé par la macro, les codes ne sont plus les mêmes(pas pour tous).
C'est à dire que par exemple, j'ai un code "0825000" dans mon fichier d'origine, et dans la colonne concernée du fichier arrivée, il devient, après création du csv, "825000"....

Alors j'ai bien tenté un:

Cells.NumberFormat = "@"

juste après le

Workbooks.Add

mais cela ne change rien.

En essayant de comprendre la macro, j'ai aussi tenté un:

SpecialCells(xlCellTypeSameFormatConditions)

à la place de

SpecialCells(xlCellTypeConstants)

mais la macro ne fonctionne plus ensuite...(ce qui prouve que j'ai encore du chemin à parcourir......)

Merci d'avance pour ton aide.

Ma requête est importante car ces codes doivent être réimportés tel quels dans le SI et si un code n'est pas connu (parce qu'il a changé), ca va planter.....et comme vous avez pu le voir, des codes , il y en a à revendre.....

Pour la Deuxième macro, elle fonctionne.

Cependant, j'ai voulu l'appliquer sur un autre fichier et sur une autre colonne ne contenant plus des codes mais du texte (parfois un mot, parfois un groupe de mot avec ou sans tirets...bref du texte).
De nouveau , je sèche. J'essaie de comprendre la macro mais lorsque je pense avoir compris, la transposition ne marche plus.

je vous mets une version allégée avec la macro précédente. Le travail devant s'effectuer sur la colonne R, j'ai modifié le paramètre de la fonction SPLIT. C'est un premier pas...

EDIT 15:45

Je viens de refaire des test pas à pas. Voyant que ça avait l'air de fonctionner, j'ai éxécuter le code entièrement. A l'ouverture de certains fichiers csv créés, j'ai pu remarquer que certaines lignes sont restée sur la première cellule avec les séparation par ";", alors que toutes les autres ont bien les données recopiées dans leur cellules respectives. Bizarre. Est-ce que la macro irait trop vite?

job75 · 9 Octobre 2014

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

Bonjour surgeon,

Je pense que sur un fichier csv le seul moyen d'afficher des zéros non significatifs devant les nombres est d'introduire un guillemet anglais (quote).

Testez cette macro :

Code:

Sub FormatageValeursNumeriquesColonneD()
Dim fichier$, c As Range, s
fichier = ThisWorkbook.Path & "\test.csv" 'à adapter
Application.ScreenUpdating = False
On Error Resume Next
With Workbooks.Open(fichier)
  For Each c In .Sheets(1).[A:A].SpecialCells(xlCellTypeConstants)
    s = Split(c, ";")
    If IsNumeric(s(3)) Then
      's(3) = "'0" & CDbl(s(3))
      s(3) = Format(s(3), "'0000000")
      c = Join(s, ";")
    End If
  Next
  .Close True
End With
End Sub

Mais peut-être faudra-t-il supprimer ce guillemet quand vous effectuerez vos comparaisons.

Il serait alors plus judicieux de faire le formatage lors de la comparaison...

A+

job75 · 10 Octobre 2014

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

Bonjour surgeon, le forum,

job75 à dit:
Il serait alors plus judicieux de faire le formatage lors de la comparaison...

Quel est en effet l'intérêt de "formater" la colonne D ?

Si c'est par exemple le nom du fichier que l'on veut formater il suffit d'ajouter une ligne :

Code:

'--------
      If IsNumeric(x) Then x = Format(x, "0000000") 'formatage du nom
      ActiveWorkbook.SaveAs chemin & dossier & x, xlCSV

La colonne D reste ce qu'elle est.

Bonne journée.

surgeon84fr · 10 Octobre 2014

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

Bonjour à tous

Merci.

Je teste.

Et pour la suite de ma question, avez-vous pu regarder avec le fichier joint?

Cdlt.

EDIT 9:22

Le formatage fonctionne

je vais (surement la semaine prochaine) tester l'importation dans le SI pour voir si l'ensemble est accepté comme ça ou pas.

Si ça mache pas.....ben...je crois que je vais revenir à la création manuelle......

Merci en tout cas.

job75 · 10 Octobre 2014

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

surgeon à dit:
Et pour la suite de ma question, avez-vous pu regarder avec le fichier joint?

Oui, je n'ai rien constaté d'anormal.

A+

job75 · 10 Octobre 2014

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

Re,

Ah oui il n'y a que 18 fichiers créés au lieu de 25.

La raison : en colonne R il y a des noms avec les deux points ":".

C'est un caractère interdit dans les noms de fichiers...

Edit : pour connaître les fichiers non créés :

Code:

'--------
      On Error Resume Next
      ActiveWorkbook.SaveAs chemin & dossier & x, xlCSV
      If Err Then MsgBox x

Pour les créer quand même remplacer les 2 points par "#" :

Code:

'--------
      x = Replace(x, ":", "#") 'caractère interdit
      ActiveWorkbook.SaveAs chemin & dossier & x, xlCSV

A+

surgeon84fr · 11 Octobre 2014

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

Bonjour à tous

merci bcp

je teste au bureau dès lundi.

Bon WE

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

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Partager cette page

Statistiques des forums