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

[cathodique]

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.

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.

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.

 

[alexga78]

Bonjour @cathodique, le forum,

Si jamais l'option Power Query est envisageable pour vous, une proposition.
Il suffit d'ajouter le chemin de votre dossier content les .csv.

Cordialement,

 

[cathodique]

Bonjour @cathodique, le forum,

Si jamais l'option Power Query est envisageable pour vous, une proposition.
Il suffit d'ajouter le chemin de votre dossier content les .csv.

Cordialement,

Bonjour @alexga78 ,

Je te remercie pour ta proposition.
C'est une solution VBA que je recherche.

Bon week-end.

 

[alexga78]

Re,

Peut-être ajouter une raz (n = 0: Erase A) avant le début de la boucle Do While Not EOF(1) .

Cordialement,

 

[job75]

Bonjour cathodique, alexga78,

Une solution VBA très simple :

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+

 

[job75]

Je ne me suis pas préoccupé de savoir si les en-têtes de colonnes correspondent bien.

J'espère que ce sera toujours le cas.

 

[job75]

Cela dit si les en-têtes sont modifiées ça ne pose aucun problème :

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

 

[cathodique]

Re,

Peut-être ajouter une raz (n = 0: Erase A) avant le début de la boucle Do While Not EOF(1) .

Cordialement,

Bonjour @alexga78 ,

C'est ce que j'ai fait entre temps. Et, ça fonctionne mieux.
Merci beaucoup.

 

[cathodique]

Cela dit si les en-têtes sont modifiées ça ne pose aucun problème :

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

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?

 

[job75]

edit: n'y a-t-il pas une solution sans ouvrir les csv?

Bien sûr en lecture séquentielle, c'est ce que fait ta macro du post #1.

Mais avec seulement 2 fichiers CSV le plus simple est de les ouvrir normalement.

Avec Workbooks.OpenText il n'y a pas de problème pour les dates.

 

[cathodique]

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]

L'ouverture en lecture séquentielle fera gagner beaucoup de temps, voici le code :

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

 

[cathodique]

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.

Bonne soirée.

 

[job75]

Chez moi je n'observe rien de tel.

La macro est affectée au bouton, je clique dessus c'est tout.

 

[cathodique]

Chez moi je n'observe rien de tel.

La macro est affectée au bouton, je clique dessus c'est tout.

J'avoue ne rien comprendre. Suite à ta réponse, j'ai retesté et ça fonctionne parfaitement.

Encore merci.

Bonne soirée.