XL 2010 Problème màj feuilles depuis fichiers CSV

cathodique

cathodique

XLDnaute Barbatruc
Bonjour,

Je voudrais faire une mise à jour de 2 tableaux structurés depuis 2 fichiers CSV.
Je rencontre plusieurs difficultés:

1 - Une solution m'avait été donnée par @job75 (que je salue, si mes souvenirs sont bons) pour gérer l'inversion de dates se trouvant en colonne 1.
VB: 
S = Split(texte, ";")(0)   'item de la 1ère colonne
               texte = Format(S, "m/d/yyyy") & Mid(texte, Len(S) + 1)   'date au format US en 1ère colonne Job75
Or, dans mes tableaux les dates ne sont pas dans les mêmes colonnes.
Peut-on déterminer par code les numéros de colonne comportant des dates dans un fichier séquentiel ou csv?

2 - Je fais une boucle sur les feuilles concernées. Pour la 1ère boucle, le résultat sur la feuille est correct sauf pour la colonne date (colonne 2).
Cependant, pour la seconde boucle, le résultat est catastrophique. Sur la feuille, j'obtiens le 1er fichier et en dessous le second. Il me semble que la 1ère séquence est gardée en mémoire.
Il y a bien l'instruction (Close #1) de fermeture du fichier séquentiel.
Code: 
Option Explicit

Sub MàJ_CSV()
   Dim texte$, S$, A$(), n&, Wsh, Chemin As String, Fichier As String, NomTb As String, StyleTb As String
   Dim CelDeb As Range, Lo As ListObject
   Application.ScreenUpdating = False
   Chemin = ThisWorkbook.Path   'on définit le chemin d'accès
   ' Vérifier que le répertoire "Sauvegarde CSV" existe
   If Not Dossier_Existe(Chemin, "Sauvegarde CSV") Then Exit Sub
   ' Ajouter le dossier Sauvegarde CSV au chemin
   Chemin = Chemin & "\Sauvegarde CSV"   'on définit le chemin d'accès
   ChDir Chemin    'se place dans le r
   For Each Wsh In Array(ShFa, ShFb)
      Fichier = Chemin & "\" & Wsh.Name & ".csv"
      If FichierExiste(Fichier) Then
         With Wsh
            .Activate
            Set CelDeb = .[A1]
            NomTb = Sheets(Wsh.Name).ListObjects(1)
            StyleTb = Sheets(Wsh.Name).ListObjects(1).TableStyle
            Debug.Print NomTb, StyleTb

            Sheets(Wsh.Name).ListObjects(1).Delete
            Open Fichier For Input As #1   'input accès au fichier
            Do While Not EOF(1)   'EndOfFile: fin du fichier
               Line Input #1, texte   'récupère la ligne
               S = Split(texte, ";")(0)   'item de la 1ère colonne
               texte = Format(S, "m/d/yyyy") & Mid(texte, Len(S) + 1)   'date au format US en 1ère colonne Job75
               ReDim Preserve A(n)   'tableau VBA, base 0
               A(n) = texte   'stocke le texte dans le tableau a
               n = n + 1
            Loop
            Close #1

            With CelDeb.Resize(n)
               .Value = Application.Transpose(A)   'restitution, Transpose est limitée à 65536 lignes
               .TextToColumns CelDeb, xlDelimited, Semicolon:=True   'commande Convertir
               .Parent.Columns.AutoFit   'ajustement largeur
            End With
            Set Lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
            With Lo
               .Name = NomTb
               .TableStyle = StyleTb
            End With
         End With
      End If

   Next Wsh
   Exit Sub

End Sub

Je suis perdu. Merci de me venir en aide.

Bonne journée.
 

Pièces jointes

  • MonDossier.zip
    36.4 KB · Affichages: 7
Solution
job75
L'ouverture en lecture séquentielle fera gagner beaucoup de temps, voici le code :
VB: 
Sub MàJ_CSV()
Dim chemin, f, LO As ListObject, fichier$, titre$, n&, texte$, s, i%, a$()
chemin = ThisWorkbook.Path & "\Sauvegarde CSV\"
Application.ScreenUpdating = False
For Each f In Array("Fa", "Fb")
    Set LO = Sheets(f).ListObjects(1)
    If Not LO.DataBodyRange Is Nothing Then LO.DataBodyRange.Delete xlUp
    fichier = chemin & f & ".csv"
    If Dir(fichier) <> "" Then 'si le fichier existe
        Open fichier For Input As #1 'ouverture en lecture séquentielle
        Line Input #1, titre   'récupère la 1ère ligne
        n = 0
        While Not EOF(1) 'EndOfFile: fin du fichier
            Line Input #1, texte
            s = Split(texte...
Trier par date Trier par votes
cathodique

cathodique

XLDnaute Barbatruc
Bonjour @job75

job75 à dit:
Sans ce format US on n'obtiendrait pas la date 06/08/2020 mais 08/06/2020.
Cliquez pour agrandir...
Je ne mets pas en doute tes compétences.
Dans mon classeur de travail, les colonnes dates sont bien au format Date jj/mm/aaaa.
Mais après avoir exécuter le code, le 06/08/2020 est 08/06/2020.
En vérifiant le format de la cellule après exécution du code, il est Personnalisé jj/dd/aaaa et non comme tu me l'indiques au format Date jj/mm/aaaa.
Alors qu'initialement le format dans mes tableaux structurés était bien au format Date jj/mm/aaaa.
Je ne comprends vraiment pas.

Les fichiers CSV ont étaient créés avec la procédure "Backup" (je crois que c'est la tienne (si bon souvenir) adaptée à mes besoins. Je voulais justement te poser une question en rapport avec cette procédure.
VB: 
Sub Backup()
   Dim chemin As String, t(), fichier As String, Chaine As String
   Dim L As Long, f As Integer, c As Integer, Wsh

   Application.ScreenUpdating = False
   chemin = ThisWorkbook.Path   'on définit le chemin d'accès
   ' Vérifier que le répertoire "Sauvegarde CSV" existe
   If Not Dossier_Existe(chemin, "Sauvegarde CSV") Then Exit Sub
   ' Ajouter le dossier Sauvegarde CSV au chemin
   chemin = chemin & "\Sauvegarde CSV"   'on définit le chemin d'accès
   ChDir chemin    'se place dans le repertoire du fichier

   For Each Wsh In Array(ShFa, ShFb) 'j'utilise CodeName car feuilles pourraient être renommées'
      With Wsh
         fichier = chemin & "\" & Wsh.Name & ".csv"
         If Dir(fichier) = "" Then GoTo suite
         SetAttr fichier, vbNormal  'attribut normal (lecture/ecriture)
suite:
         ' Créer les fichiers CSV
         t = .Range("A1").CurrentRegion.Value
         f = FreeFile()
         Open fichier For Output As #f
         For L = 1 To UBound(t, 1)  'boucle sur le nombre de ligne
            Chaine = t(L, 1)
            For c = 2 To UBound(t, 2)  '**********boucle sur le nombre de colonne '*******
               Chaine = Chaine & ";" & t(L, c)  'on récupère les données séparées avec une virgule (csv)
            Next c
            Print #f, Chaine  'ecriture dans le fichier csv
         Next L
         Close #f  ' on ferme le fichier
         SetAttr fichier, vbReadOnly  'on met le fichier en lecture seule 
      End With
   Next
   Application.ScreenUpdating = True
End Sub
ma question est par rapport à la boucle avec astérisques. Pourquoi la boucle commence à 2?
En commençant à 1, j'ai obtenu 2 fois la 1ère colonne. Là, aussi je suis dans le flou.

Merci beaucoup.

Bonne journée.
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
Bonjour cathodique

Il faut que la colonne entière soit mise avant au format "jj/mm/aaaa".

Le fichier que j'ai joint ne pose aucun problème, utilise-le.

A+
Cliquez pour agrandir...
Très bien. J'ai remarqué que sur le fichier le code fonctionne très bien.
Ok, je vais formater toutes les colonnes date au format date.

Stp, tu n'aurais pas une explication à ma seconde question, concernant la boucle.

Merci beaucoup.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour cathodique, le forum,

Dans cette autre discussion j'importe des fichiers CSV par requête QueryTables.

En appliquant cette méthode ici on obtient cette macro :
VB: 
Sub MàJ_CSV()
Dim chemin, f, LO As ListObject, dest As Range, fichier
chemin = ThisWorkbook.Path & "\Sauvegarde CSV\"
Application.ScreenUpdating = False
For Each f In Array("Fa", "Fb")
    Set LO = Sheets(f).ListObjects(1) 'tableau structuré
    Set dest = LO.Range
    LO.Unlist convertit le tableau en plage
    dest.Clear 'RAZ
    fichier = chemin & f & ".csv"
    If Dir(fichier) <> "" Then 'si le fichier existe
        With Sheets(f).QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=dest(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
            Set dest = Evaluate(.Parent.Names(.Name).RefersTo)
            .Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
            .Delete 'supprime la requête
        End With
        Sheets(f).ListObjects.Add xlSrcRange, dest, , xlYes 'recrée un tableau structuré
    End If
Next f
End Sub
Elle est très rapide et il n'y a plus de problème avec les dates.

A+
 

Pièces jointes

  • MonDossier.zip
    36.6 KB · Affichages: 1
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
Bonjour cathodique, le forum,

Dans cette autre discussion j'importe des fichiers CSV par requête QueryTables.

En appliquant cette méthode ici on obtient cette macro :
VB: 
Sub MàJ_CSV()
Dim chemin, f, LO As ListObject, dest As Range, fichier
chemin = ThisWorkbook.Path & "\Sauvegarde CSV\"
Application.ScreenUpdating = False
For Each f In Array("Fa", "Fb")
    Set LO = Sheets(f).ListObjects(1) 'tableau structuré
    Set dest = LO.Range
    LO.Unlist convertit le tableau en plage
    dest.Clear 'RAZ
    fichier = chemin & f & ".csv"
    If Dir(fichier) <> "" Then 'si le fichier existe
        With Sheets(f).QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=dest(1))
            .TextFileParseType = xlDelimited
            .TextFileSemicolonDelimiter = True
            .Refresh
            Set dest = Evaluate(.Parent.Names(.Name).RefersTo)
            .Parent.Names(.Name).Delete 'supprime le nom défini dans la feuille
            .Delete 'supprime la requête
        End With
        Sheets(f).ListObjects.Add xlSrcRange, dest, , xlYes 'recrée un tableau structuré
    End If
Next f
End Sub
Elle est très rapide et il n'y a plus de problème avec les dates.

A+
Cliquez pour agrandir...
Bonjour @job75 ;) ,

On dirait que tu lis dans mes pensées. Je te remercie infiniment.
Je regarderai plus attentivement ton code quand mon train de vie reviendra à la normale.

Bonne journée.
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
Microsoft 365 Aide adaptation d'une macro
Réponses
2
Affichages
245
netparty
N
C
  • Résolu(e)
XL 2019 Importer fichier csv sans consatener les colonnes
2 3
Réponses
34
Affichages
2 K
laurent950
laurent950
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
445
job75
job75
B
  • Question
XL 2016 Propriétés fichiers vidéos.
Réponses
3
Affichages
445
patricktoulon
patricktoulon
L
  • Question
Autres Copier des données d’un fichier sans l’ouvrir juste en le sélectionnant via un UserForm
Réponses
6
Affichages
650
Liner77
L
M
  • Résolu(e)
XL 2016 comment créer une Barre de défilement ou faire simplement défiler son texte ?
2
Réponses
25
Affichages
967
melltel
M
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
484
marie3107
M
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
329
marie3107
M
U
  • Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
303
Phil69970
Phil69970
L
  • Résolu(e)
Microsoft 365 Décompte via plusieurs fichiers CSV
Réponses
12
Affichages
596
WTF
WTF

Membres actuellement en ligne

9 membres et 64 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
314 720
Messages
2 112 187
Membres
111 457
dernier inscrit
anglade