Comparer date dans fichier fermé

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion cathodique
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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.😀
 

Pièces jointes

Trier par date Trier par votes
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

Dernière édition:
Vote positif 0 Vote négatif
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
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
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
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
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
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
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
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

O
  • Question Question
XL 2013 Planification automatique des rdv d'intervention en fonction des dates disponibles
Réponses
3
Affichages
428
cathodique
cathodique
cathodique
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
3 K
cathodique
cathodique
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
2 K
Pac41240
P
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
826
TooFatBoy
TooFatBoy
D
  • Question Question
XL 2016 Future date la plus proche d'aujourd'hui + mise en forme conditionnelle
Réponses
8
Affichages
493
vgendron
vgendron
R
  • Résolu(e)
XL 2019 Recherche valeur (Critère date et ID) et copier valeur dans tableau dans la cellule correspondante
3 4 5
Réponses
66
Affichages
4 K
Rabeto
R
A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
772
arnoldbrice19
A
A
  • Question Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
3 K
Amilo
A
oguruma
POWERQUERY :: Importation d'un fichier texte .csv et sélection dynamique entre deux dates
Réponses
1
Affichages
630
oguruma
oguruma
chaelie2015
  • Résolu(e)
XL 2013 Gestion Automatisée des Dates en Fonction des Périodes et des Mois
Réponses
9
Affichages
985
Phil69970
Phil69970
A
  • Question Question
XL 2010 Date dans fichier pour impression pdf
Réponses
2
Affichages
1 K
Aldonanou
A
oguruma
POWERQUERY :: Importer un fichier .csv avec construction de critères dynamiques (5 max) de type texte et sélection entre deux dates possible - V2.0
Réponses
0
Affichages
869
oguruma
oguruma
F
  • Question Question
XL 2019 Remplissage de champs dans doc Word à partir d'excel
Réponses
4
Affichages
1 K
Staple1600
Staple1600
Lu76Fer
Office XLS : Fonction simplifiant l'utilisation de la fenêtre FileDialog
Réponses
6
Affichages
831
Lu76Fer
Lu76Fer
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
1 K
Messan
Messan
E
  • Question Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
1 K
fanch55
fanch55
P
  • Question Question
XL 2016 rechercher si une date est comprise entre 2 dates de 2 onglets positionnées dans la même cellule
Réponses
2
Affichages
875
pene
P
A
  • Résolu(e)
Microsoft 365 Excel 365 x Power Query : suivi campagnes promotionnelles
Réponses
4
Affichages
1 K
Atsuki
A
J
  • Question Question
Autres Comment faire une comparaison entre plusieurs fichier CSV et XML
Réponses
0
Affichages
969
JdW
J
J
  • Résolu(e)
Microsoft 365 macro effacement sélection cellules
2 3 4
Réponses
55
Affichages
4 K
Phil69970
Phil69970
Retour