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

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

job75

XLDnaute Barbatruc
Bonjour cathodique, alexga78,

Une solution VBA très simple :
VB:
Sub MAJ()
Dim chemin, f, LO As ListObject
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
    Workbooks.OpenText chemin & f & ".csv", Local:=True
    ActiveWorkbook.Sheets(1).[A1].CurrentRegion.Copy LO.Range.Cells(2, 1)
    LO.Range.Rows(2).Delete xlUp
    ActiveWorkbook.Close
Next
End Sub
A+
 

Pièces jointes

  • MonDossier.zip
    37.8 KB · Affichages: 8

job75

XLDnaute Barbatruc
Cela dit si les en-têtes sont modifiées ça ne pose aucun problème :
VB:
Sub MAJ()
Dim chemin, f, LO As ListObject
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
    Workbooks.OpenText chemin & f & ".csv", Local:=True
    ActiveWorkbook.Sheets(1).[A1].CurrentRegion.Copy LO.Range.Cells(2, 1)
    ActiveWorkbook.Sheets(1).[A1].CurrentRegion.Rows(1).Copy LO.Range.Cells(1) 'en-têtes
    LO.Range.Rows(2).Delete xlUp
    LO.Range.Columns.AutoFit 'ajustement largeurs
    ActiveWorkbook.Close
Next
End Sub
 

Pièces jointes

  • MonDossier.zip
    38.2 KB · Affichages: 5

cathodique

XLDnaute Barbatruc
Cela dit si les en-têtes sont modifiées ça ne pose aucun problème :
VB:
Sub MAJ()
Dim chemin, f, LO As ListObject
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
    Workbooks.OpenText chemin & f & ".csv", Local:=True
    ActiveWorkbook.Sheets(1).[A1].CurrentRegion.Copy LO.Range.Cells(2, 1)
    ActiveWorkbook.Sheets(1).[A1].CurrentRegion.Rows(1).Copy LO.Range.Cells(1) 'en-têtes
    LO.Range.Rows(2).Delete xlUp
    LO.Range.Columns.AutoFit 'ajustement largeurs
    ActiveWorkbook.Close
Next
End Sub
Bonjour @job75 ;) ,

Je te remercie beaucoup. Si mes souvenirs sont bons, tu m’avais aidé concernant l’inversion jour et mois d'une date lors de l'import d'un fichier csv.
Je n'ai pas encore vérifié sur mon fichier de travail qu'il n'y aura pas cette inversion avec ton dernier code.
J'ai finalement compris cette ligne de ton précédent code
VB:
texte = Format(S, "m/d/yyyy") & Mid(texte, Len(S) + 1)   'date au format US en 1ère colonne Job75
Je n'arrive juste pas à l'adapter à mon Besoin.

Merci beaucoup.
Bonne fin de journée.

edit: n'y a-t-il pas une solution sans ouvrir les csv?
 
Dernière édition:

cathodique

XLDnaute Barbatruc
Bien sûr en lecture séquentielle, c'est ce que fait ta macro du post #1.
Sauf erreur de ma part, c'est ta macro à laquelle je n'ai rajouté que la vérification du dossier et des fichiers csv.
Je te remercie encore une fois. Elle fonctionne parfaitement dans mon précédent fichier.

Mais avec seulement 2 fichiers CSV le plus simple est de les ouvrir normalement.
En fait, je n'ai mis que 2 pour le fichier joint. Pour le moment, dans mon véritable fichier il y en a 3.
Je ne suis qu'au début de mon projet. Je ne sais donc pas quel sera le nombre exact.

Merci beaucoup.
 

job75

XLDnaute Barbatruc
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, ";")
            For i = 0 To UBound(s)
                If IsDate(s(i)) Then s(i) = Format(s(i), "m/d/yyyy") 'format US
            Next i
            texte = Join(s, ";")
            ReDim Preserve a(n)   'tableau VBA, base 0
            a(n) = texte   'stocke le texte dans le tableau a
            n = n + 1
        Wend
        Close #1
        '---restitution---
        With LO.Range
            .Cells(1) = titre
            Application.DisplayAlerts = False
            .Cells(1).TextToColumns .Cells(1), xlDelimited, Semicolon:=True   'commande Convertir
            If n Then
                .Cells(2, 1).Resize(n) = Application.Transpose(a)
                .Cells(2, 1).Resize(n).TextToColumns .Cells(2, 1), xlDelimited, Semicolon:=True  'commande Convertir
            End If
            .Columns.AutoFit   'ajustement largeurs
         End With
    End If
Next f
End Sub
 

Pièces jointes

  • MonDossier.zip
    38.7 KB · Affichages: 12

cathodique

XLDnaute Barbatruc
Bonsoir @job75 ,

Je te remercie beaucoup. Mais ai-je fait une connerie?
J'ai dézippé, ouvert le fichier et exécuté le code.
Mais plante dès le début. Message: "Argument ou appel de procédure incorrect"
Je n'ai pas compris le pourquoi. Merci de me venir en aide.
Probleme.gif

Bonne soirée.
 

Discussions similaires