Comparer date dans fichier fermé

cathodique

cathodique

XLDnaute Barbatruc
Bonsoir:),

J'ai un code qui me permet d'importer un fichier csv. Ce fichier csv à une ligne d'entete, en colonne A des dates.

Je voudrais vérifier que l'année en colonne A du fichier csv est égale à l'année en B1 de la feuille nommée date.

Si cette condition est remplie, l'import s'effectue sinon on arrête l'import et on prévient l'utilisateur.

En vous remerciant.

Bonne soirée.

NB: fichier csv non autorisé sur XLD.:D
 

Pièces jointes

  • Import csv.xlsm
    21.9 KB · Affichages: 22
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re,

En fait le traitement séquentiel d'un tableau CSV est très rapide.

A condition d'utiliser un tableau VBA pour stocker les données et les restituer en bloc.

Et d'utiliser la commande Convertir chère à JM ;)

J'ai donc complètement revu le code :
Code: 
Dim CelDeb As Range

Sub ChoixFichier()
   Dim fichier As Variant
   fichier = Application.GetOpenFilename("Tous les fichiers (*.csv),*.csv")
   If fichier = False Then Exit Sub
   Feuil1.Cells.Delete 'RAZ
   Set CelDeb = Feuil1.[A5]
   Lecture fichier
End Sub

Sub Lecture(fichier)
   Dim texte$, s$, a$(), n&

   Open fichier For Input As #1 '1er input accès au fichier #1:numéro du fichier
   Line Input #1, texte 'lecture 1ère ligne
   On Error Resume Next 'sécurité
   Line Input #1, texte 'lecture 2ème ligne
   If Year(Split(texte, ";")(0)) <> Year(Sheets("date").[B1]) Then _
      MsgBox "Ce fichier ne correspond pas à l'année en date!B1...": Close #1: Exit Sub
   On Error GoTo 0
   Close #1 '1ère fermeture du fichier

   Open fichier For Input As #1 '2ème 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
      ReDim Preserve a(n) 'tableau VBA, base 0
      a(n) = texte 'stocke le texte dans le tableau a
      n = n + 1
   Loop
   Close #1 '2ème fermeture du fichier pour décharger la mémoire

   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

End Sub
Si le tableau devait dépasser 65536 lignes il faudrait faire faire la transposition par une boucle.

Noter que les dates du fichier CSV pourraient être au format jj/mm/aa.

On ne le verrait pas en ouvrant le fichier avec Excel qui les restitue au format jj/mm/aaaa.

C'est pour cette raison que j'utilise Split et la variable s.

Fichiers (4), l'exécution se fait maintenant en 9 millièmes de seconde...

Edit : fichiers (4 bis) pour le cas où le tableau dépasse 65536 lignes.

A+
 

Pièces jointes

  • Import csv(4).zip
    26.3 KB · Affichages: 18
  • Import csv(4 bis).zip
    26.5 KB · Affichages: 16
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour cathodique, le forum,

Pour finir j'ai testé sur un fichier CSV de 100 000 lignes (8,4 Mo) :

- fichier (4 bis) du post #16 => 6,0 secondes

- macro du post #10 => 6,3 secondes.

Je n'avais pas fait attention : la macro du post #6 ne restitue pas les dates correctement.

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

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

@job75
Pour continuer
Il restait cette voie qu'on n'a pas explorée ;)
VB: 
Sub Importer_CSV()
Dim ws As Worksheet, fichier As Variant
Set ws = Sheets("Exercice")
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'sécurité
With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("A1"))
     .TextFileParseType = xlDelimited
     .TextFileSemicolonDelimiter = True
     .Refresh
End With
If Year(Sheets("Exercice").[A2]) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
Else
Sheets("Exercice").Cells.Clear
End If
End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Staple1600 à dit:
Re

@cathodique
Euh, moi je n'ai fait qu'ajouter cette ligne
Workbooks.OpenText fichier, local:=True

NB1: Tant mieux pour les animaux, même si avant les animaux, on devrait peut être se focaliser sur l'humain (famine, guerre... etc)
Mais ceci est une autre histoire et Excel avec ou sans macros ne pourra pas faire grand chose.

NB2: J'utilise ce genre de syntaxe dans la plupart des posts qui traite de CSV
Est-ce à dire que tu n'as pas utilisé le moteur de recherche du forum avant de poser ta question ? ;)
Cela devrait pourtant être un réflexe basique pour un membre inscrit depuis 2012 ;)
Cliquez pour agrandir...
Bonjour JM:),
Concernant le NB1: Qu'a fait l'humain jusqu'à nos jours? Pour moi, y a pas photo, il n'a fait que se détruire car bourré de défauts que les animaux n'ont pas. Individuellement, nous ne pouvons rien y changer.

Pour NB2: recherche sur le forum, c'est que j'ai fait. et le retour dépendant des critères utilisés. c'est à la suite de lecture de plusieurs post que j'ai posé ma question. En effet, membre depuis 2012. Cependant, je ne suis pas connecté h24. Je ne suis qu'un codeur du dimanche pour le plaisir.

Merci beaucoup pour ton aide, c'est ce qui fait vivre le forum (question/réponse).

Bon dimanche.
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Staple1600 à dit:
Bonjour le fil, le forum

@job75
Pour continuer
Il restait cette voie qu'on n'a pas explorée ;)
VB: 
Sub Importer_CSV()
Dim ws As Worksheet, fichier As Variant
Set ws = Sheets("Exercice")
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'sécurité
With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("A1"))
     .TextFileParseType = xlDelimited
     .TextFileSemicolonDelimiter = True
     .Refresh
End With
If Year(Sheets("Exercice").[A2]) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
Else
Sheets("Exercice").Cells.Clear
End If
End Sub
Cliquez pour agrandir...
Merci beaucoup, j'apprécie mais allez doucement, je commence à perdre pied.
Surtout que j'ai toujours eu des problèmes avec les dates.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour JM,

Hé tu effaces tout à la fin !? C'est au début qu'il faut effacer.

Ta nouvelle solution est moins rapide => 10,5 secondes sur 100 000 lignes.

Ci-joint le dossier final avec les 3 solutions.

A+
 

Pièces jointes

  • Import csv.zip
    73.8 KB · Affichages: 26
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour job75

@job75
Oui, le dimanche, j'efface tout*
Tabula rasa pour commencer un lundi de fiesta ;)

*: J'ai juste repris la structure de ton code du message#6

Me suis relu et ai amendé en conséquence ;)
VB: 
Sub CSV_Import_II()
Dim ws As Worksheet, fichier As Variant
Set ws = Sheets("Exercice")
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'sécurité
With ws
    With .QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileSemicolonDelimiter = True
        .Refresh
    End With
    If Year(.Range("A2")) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
    MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
    .Cells.Clear
    End If
End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Soyons fou ;)
Je remets une pièce dans le nourrin ;)

VB: 
Sub Import_CSV_III()
Dim MyData As String, strData() As String, t
t = Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False: Application.DisplayAlerts = False
On Error Resume Next 'sécurité
Open fichier For Binary As #1: MyData = Space$(LOF(1)): Get #1, , MyData: Close #1
strData() = Split(MyData, vbCrLf)
With Sheets("Exercice")
    .Cells.Clear
    .[A1].Resize(UBound(strData)) = Application.Transpose(strData)
    .Columns("A:A").TextToColumns Range("A1"), xlDelimited, Semicolon:=-1, FieldInfo:=t
    If Year(.Range("A2")) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
    MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
    .Cells.Clear
    End If
End With
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re,

Ta dernière macro revue pour pouvoir transposer plus de 65536 lignes :
Code: 
Sub Import_CSV()
Dim t, fichier, MyData$, strData$(), a(), i&
t = Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Open fichier For Binary As #1: MyData = Space$(LOF(1)): Get #1, , MyData: Close #1
strData() = Split(MyData, vbCrLf)
ReDim a(UBound(strData), 0)
For i = 1 To UBound(a)
    a(i, 0) = strData(i) 'transposition
Next
With Sheets("Exercice")
    .Cells.Clear
    .[A1].Resize(UBound(a)) = a
    .Columns("A:A").TextToColumns Range("A1"), xlDelimited, Semicolon:=-1, FieldInfo:=t
    On Error Resume Next 'sécurité
    If Year(.Range("A2")) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
        MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
        .Cells.Clear
    End If
End With
End Sub
Sur un fichier de 100 000 lignes l'exécution se fait en 7,5 secondes (parfois plus).

A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@job75
Je crois que j'ai plus d'autre façon d'ouvrir un fichier CSV en stock ;)
Et toi?
VB: 
Sub Import_CSV_IV()
Dim objFSO As Object, objTF As Object, MyData As String, strData() As String, fichier, t
Set objFSO = CreateObject("Scripting.FileSystemObject")
t = Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), _
    Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))
fichier = Application.GetOpenFilename("Fichier CSV (*.csv),*.csv", , "Choisissez le fichier à importer...")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False: Application.DisplayAlerts = False: On Error Resume Next 'sécurité
Set objTF = objFSO.OpenTextFile(CStr(fichier), 1)
MyData = objTF.ReadAll: strData = Split(MyData, vbCrLf): objTF.Close
With Sheets("Exercice")
    .Cells.Clear
    .[A1].Resize(UBound(strData) + 1, 1) = Application.Transpose(strData)
    .Columns("A:A").TextToColumns Range("A1"), xlDelimited, Semicolon:=-1, FieldInfo:=t
    If Year(.Range("A2")) <> Year(ThisWorkbook.Sheets("date").[B1]) Then 'test à adapter éventuellement
    MsgBox "Ce fichier ne correspond pas à l'année en date!B1..."
    .Cells.Clear
    End If
End With
End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
job75 à dit:
Re,

En fait le traitement séquentiel d'un tableau CSV est très rapide.

A condition d'utiliser un tableau VBA pour stocker les données et les restituer en bloc.

Et d'utiliser la commande Convertir chère à JM ;)

J'ai donc complètement revu le code :
Code: 
Dim CelDeb As Range

Sub ChoixFichier()
   Dim fichier As Variant
   fichier = Application.GetOpenFilename("Tous les fichiers (*.csv),*.csv")
   If fichier = False Then Exit Sub
   Feuil1.Cells.Delete 'RAZ
   Set CelDeb = Feuil1.[A5]
   Lecture fichier
End Sub

Sub Lecture(fichier)
   Dim texte$, s$, a$(), n&

   Open fichier For Input As #1 '1er input accès au fichier #1:numéro du fichier
   Line Input #1, texte 'lecture 1ère ligne
   On Error Resume Next 'sécurité
   Line Input #1, texte 'lecture 2ème ligne
   If Year(Split(texte, ";")(0)) <> Year(Sheets("date").[B1]) Then _
      MsgBox "Ce fichier ne correspond pas à l'année en date!B1...": Close #1: Exit Sub
   On Error GoTo 0
   Close #1 '1ère fermeture du fichier

   Open fichier For Input As #1 '2ème 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
      ReDim Preserve a(n) 'tableau VBA, base 0
      a(n) = texte 'stocke le texte dans le tableau a
      n = n + 1
   Loop
   Close #1 '2ème fermeture du fichier pour décharger la mémoire

   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

End Sub
Si le tableau devait dépasser 65536 lignes il faudrait faire faire la transposition par une boucle.

Noter que les dates du fichier CSV pourraient être au format jj/mm/aa.

On ne le verrait pas en ouvrant le fichier avec Excel qui les restitue au format jj/mm/aaaa.

C'est pour cette raison que j'utilise Split et la variable s.

Fichiers (4), l'exécution se fait maintenant en 9 millièmes de seconde...

Edit : fichiers (4 bis) pour le cas où le tableau dépasse 65536 lignes.

A+
Cliquez pour agrandir...
Un grand merci Job75, il me faut un certain temps pour assimiler tes codes.

Pour les dates, j'utilise cette fonction pour les convertir trouvée sur développez.com au fil de mes recherches avec google.
VB: 
Function DateAmFr(d As String) As Date
'origine ----> https://www.developpez.net/forums/d1461668/logiciels/microsoft-office/excel/macros-vba-excel/transformer-date-americaine-date-francaise/#post7919409
   Dim t
   Dim Y As Integer
   Dim M As Integer
   Dim j As Integer
   t = Split(d, "/")

   If Len(t(0)) = 4 Then
      Y = t(0)
      If CInt(t(1)) > 13 Then
         j = t(1)
         M = t(2)
      Else
         j = t(2)
         M = t(1)
      End If
   End If

   If Len(t(1)) = 4 Then
      Y = t(1)
      If CInt(t(0)) > 13 Then
         j = t(0)
         M = t(2)
      Else
         j = t(2)
         M = t(0)
      End If
   End If
   If Len(t(2)) = 4 Then
      Y = t(2)
      If CInt(t(0)) > 13 Then
         j = t(0)
         M = t(1)
      Else
         j = t(1)
         M = t(0)
      End If
   End If

   DateAmFr = Format(j & "/" & M & "/" & Y, "yyyy-mm-dd")

End Function

Merci beaucoup, en espérant que ce fil puisse aider.

Excusez mon retard, je suis sorti précipitamment de chez-moi (une urgence) en oubliant de poster mon brouillon.

Merci à vous, mais là je suis un peu perdu. Il me faut un peu de temps (je rigole beaucoup) pour comprendre vos avalanches de codes.

un grand bravo à vous.

Bonne semaine.
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
1 K
Amilo
A
A
  • Question
XL 2010 Date dans fichier pour impression pdf
Réponses
2
Affichages
760
Aldonanou
A
F
  • Question
XL 2019 Remplissage de champs dans doc Word à partir d'excel
Réponses
4
Affichages
524
Staple1600
Staple1600
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
626
fanch55
fanch55
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
404
Messan
Messan
J
  • Question
Autres Comment faire une comparaison entre plusieurs fichier CSV et XML
Réponses
0
Affichages
680
JdW
J
A
  • Résolu(e)
Microsoft 365 Excel 365 x Power Query : suivi campagnes promotionnelles
Réponses
4
Affichages
687
Atsuki
A
S
  • Résolu(e)
XL 2016 Séparateurs décimales & milliers sur un import csv
2
Réponses
18
Affichages
2 K
sabrina_
S
A
  • Question
XL 2019 Faire un filtre sur deux dates
Réponses
0
Affichages
488
A-F
A
A
  • Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
758
A-F
A

Membres actuellement en ligne

3 membres et 31 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 337
Messages
2 087 391
Membres
103 536
dernier inscrit
komivi