XL 2019 CSV modifier le contenu puis le transformer en xls

msauvegrain

msauvegrain

XLDnaute Nouveau
Bonjour,
Je voudrais pouvoir traiter un fichier csv par sélection dans une liste d'un répertoire : c:\a_colFR\ contenant les fichiers
puis :
  1. Effacer les 6 premières lignes
  2. Effacer les 4 dernières lignes
  3. Remplacer "Références catalogue" par "Nums"
  4. Remplacer "Date d'émission" par " Date d_émission"
  5. Remplacer "Date d'expiration" par "Date d_expiration"
  6. Enregistrer le fichier modifié en csv
  7. Puis le convertir en xls
  8. Modifier le format de cellule de la colonne FaceValue en Texte
  9. l'enregistrer sous : "X_" & la référence pays de la deuxième ligne du nouveau fichier
Les fichiers joints sont avec l'extension .txt mais ils sont en réalité des csv

Merci d'avance

J'ai été précis cette fois !!!
 

Pièces jointes

  • fr_stamps_csv_list_country_75-Guyane_FranC3A7aise.txt
    91 KB · Affichages: 15
  • fr_stamps_csv_list_country_598-Diego-Suarez.txt
    16.9 KB · Affichages: 6
Trier par date Trier par votes
msauvegrain

msauvegrain

XLDnaute Nouveau
Bonsoir, job75
Je veux traiter tout les fichiers des répertoires, je joins en .zip une partie de ceux d'Afrique . Mais j'ai un dossier par continent : a_asie, a_océanie, a_amérique, a_europe, a_ afrique et un pour les colonies françaises a_colFR

@+, Merci
 

Pièces jointes

  • a_afrique.zip
    537.3 KB · Affichages: 7
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour msauvegrain,

Voyez le fichier joint et cette macro :
VB: 
Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, nom$
dossier1 = "Fichiers CSV corrigés\" 'nom du sous-dossier, modifiable
dossier2 = "Fichiers XLS\" 'nom du sous-dossier, modifiable
remplace = Array("é", "É", "Ã~¨", "â", "½", "Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiablee
par = Array("é", "É", "è", "â", "½", "Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
    n = n + 1
    Workbooks.OpenText chemin & fichier, Comma:=True, DecimalSeparator:=".", Local:=True
    With ActiveWorkbook.Sheets(1)
        .Rows("1:6").Delete
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        .Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
        For i = 0 To UBound(par)
            .Cells.Replace remplace(i), par(i), xlPart
        Next i
        i = InStr(fichier, "_csv")
        nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)
        .SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
        .Columns(17).HorizontalAlignment = xlCenter 'centrage de FaceValue
        .SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
    End With
    ActiveWorkbook.Close
    fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub
Chaque dossier est traité séparément en le sélectionnant dans la boîte de dialogue.

Les fichiers créés sont placés dans 2 sous-dossiers créés par la macro.

Je n'ai pas compris pourquoi vous voulez mettre la colonne FaceValue au format Texte, je l'ai juste centrée.
 

Pièces jointes

  • Traitement dossiers(1).xlsm
    21.6 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
msauvegrain

msauvegrain

XLDnaute Nouveau
Bonjour, Job

Après quelques tests je ne comprends pas pourquoi certains fichiers ne sont pas traités correctement.
Ci-joint deux fichiers avec leurs traitements.
Iles Christmas pas de problème, Australie, ne fonctionne pas, je ne sais pas pourquoi ?
Et, je voudrais que le nom du fichier XLS soit du type "X_" & Nom du pays, exemple X_Australie.xls
Merci
@+, Michel
 

Pièces jointes

  • a_test.zip
    477.8 KB · Affichages: 2
  • XLS.zip
    743.8 KB · Affichages: 2
  • CSV.zip
    503 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour msauvegrain,

Pour l'Australie Workbooks.OpenText ne va pas, je ne sais pas pourquoi.

Par contre Workbooks.Open fonctionne bien sur a_afrique et a_test donc utlisez ce fichier (2) avec :
VB: 
Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, a, nom$
dossier1 = "Fichiers CSV corrigés\" 'nom du sous-dossier, modifiable
dossier2 = "Fichiers XLS\" 'nom du sous-dossier, modifiable
'remplace = Array("é", "É", "Ã~¨", "â", "½", "Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiablee
'par = Array("é", "É", "è", "â", "½", "Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
remplace = Array("Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiable
par = Array("Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
    n = n + 1
    'Workbooks.OpenText chemin & fichier, Comma:=True, DecimalSeparator:=".", Local:=True
    Workbooks.Open chemin & fichier
    With ActiveWorkbook.Sheets(1)
        .Rows("1:6").Delete
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        .Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
        For i = 0 To UBound(par)
            .Cells.Replace remplace(i), par(i), xlPart
        Next i
        i = InStr(fichier, "_csv")
        nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)
        .SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
        .Columns(17).HorizontalAlignment = xlCenter 'centrage de FaceValue
        nom = "X_" & .Cells(2, 2)
        .SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
    End With
    ActiveWorkbook.Close
    fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub
A+
 

Pièces jointes

  • Traitement dossiers(2).xlsm
    23.8 KB · Affichages: 3
Vote positif 0 Vote négatif
msauvegrain

msauvegrain

XLDnaute Nouveau
Bonsoir Job,

Après quelques essais ..., je suis arrivé à tester ton module et à modifier certaines lignes.
Le résultat me convient mieux, mais il ne fonctionne pas sur certains fichiers, j'en joint un autre qui ne marche pas.
Je sais pourquoi, il y a un ajout de guillemets sur la premier ligne du fichier csv au mauvais endroit.
Est-il possible pour le traitement de définir les limites de texte "" comme pour le séparateur virgule.

Et dernier petit truc, est-il possible de créer un classeur contenant la liste des fichiers csv modifiés.

@+, Michel
 

Pièces jointes

  • Traitement dossiers.xlsm
    24.3 KB · Affichages: 4
  • fr_stamps_csv_list_country_444-Afrique_Centrale_-_Protectorat_britannique.zip
    3.5 KB · Affichages: 2
Vote positif 0 Vote négatif
msauvegrain

msauvegrain

XLDnaute Nouveau
Bonsoir,
Jai résolu une partie de mon problème en modifiant la ligne :

Workbooks.OpenText chemin & fichier, Origin:=65001, DataType:=xlDelimited, ConsecutiveDelimiter:=False, TextQualifier:=xlDoubleQuote, Comma:=True, DecimalSeparator:=".", Local:=True

Elle force la reconnaissance de la source CSV en UTF-8(Origin) et la valeur de TextQualifier était érronée .

Maintenant, je veux forcer les colonnes E F et Q en format de cellule Texte et les colonnes G et H en décimal.

Qqn a une idée ?

Je joins le fichier modifié,

Pour Staple 1600 je voudrais inclure le traitement des noms dans la procédure.

Merci de votre aide
 

Pièces jointes

  • Traitement dossiers2.xlsm
    24.2 KB · Affichages: 1
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2019 Renommer en masse les titres de colonne des .CSV
2 3
Réponses
32
Affichages
1 K
Amilo
A
M
  • Question
Microsoft 365 Fichier CSV s'ouvre en colonnes séparées
Réponses
7
Affichages
2 K
fanch55
fanch55
msauvegrain
  • Question
XL 2019 Guillemets crées en trop, csv vers xls
Réponses
3
Affichages
991
msauvegrain
msauvegrain
P
  • Question
XL 2010 Macro et fichier .csv
2
Réponses
20
Affichages
3 K
papypog
P
S
  • Résolu(e)
XL 2016 Séparateurs décimales & milliers sur un import csv
2
Réponses
18
Affichages
2 K
sabrina_
S
P
  • Question
Power Query Problème renommage en-tête - modifier la valeur de la première cellule uniquement
Réponses
1
Affichages
638
Hasco
Hasco
J
  • Question
XL 2019 importer le contenu de plusieurs xlsx dans une même sheet d'un nouveau fichier excel
2 3
Réponses
34
Affichages
3 K
Hasco
Hasco
S
  • Résolu(e)
XL 2016 convertir un fichier .csv en .xlms
2
Réponses
23
Affichages
3 K
scoubidou35
S
K
  • Question
XL 2016 VBA - Extraire une feuille pour l'enregistrer en .csv (avec séparateur point virgule) puis l'enregistrer en .txt
Réponses
3
Affichages
2 K
Karim48
K
S
  • Résolu(e)
Microsoft 365 automatiser macro pour copier/coller des données d´un classeur à un autre et sauver à chaque fois le classeur rempli
Réponses
8
Affichages
4 K
sevenkingdom
S

Membres actuellement en ligne

1 membres et 27 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi