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

cathodique · 27 Avril 2024

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.

job75 · 27 Avril 2024

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...

cathodique · 28 Avril 2024

Bonjour @job75 ,

Hier, j'étais très fatigué je ne me suis pas rendu compte que les dates sont inversées.

job75 à dit:
If IsDate(s(i)) Then s(i) = Format(s(i), "m/d/yyyy") 'format US

Cette ligne inverse les jours et les mois.
Je voulais juste t'en informer.

Bon dimanche.

job75 · 28 Avril 2024

Bonjour cathodique,

cathodique à dit:
Cette ligne inverse les jours et les mois.

Oui bien sûr, c'est comme au post #1.

Sans ce format US on n'obtiendrait pas la date 06/08/2020 mais 08/06/2020.

Nota : les colonnes contenant des dates doivent être mises au format Date jj/mm/aaaa.

A+

cathodique · 29 Avril 2024

Bonjour @job75

job75 à dit:
Sans ce format US on n'obtiendrait pas la date 06/08/2020 mais 08/06/2020.

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.

job75 · 29 Avril 2024

Bonjour cathodique

cathodique à dit:
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

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+

cathodique · 29 Avril 2024

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+

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.

job75 · 29 Avril 2024

cathodique à dit:
ma question est par rapport à la boucle avec astérisques. Pourquoi la boucle commence à 2?

Pour concaténer à partir de la 2ème colonne, la 1ère étant utilisée dans Chaine = t(L, 1)

cathodique · 29 Avril 2024

job75 à dit:
Pour concaténer à partir de la 2ème colonne, la 1ère étant utilisée dans Chaine = t(L, 1)

Bigleux que je suis
Merci beaucoup.

job75 · 28 Mai 2024

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+

cathodique · 28 Mai 2024

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+

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.

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

cathodique

XLDnaute Barbatruc

Pièces jointes

job75

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

Discussions similaires