XL 2019 Comment comparer 2 dates vba

chris4785478547 · 20 Décembre 2020

Bonsoir à tous,

Pour savoir si une date se trouve dans un intervalle, j'ai choisi de les convertir en numérique grâce à DATEVALUE (à tort ou à raison...)
Mais ma comparaison ne marche pas, j'ai mis des espions pour déboguer et je constate que mes variables (DATEDEBUTNUMERIQUE et DATEFINNUMERIQUE) théoriquement traitées de la même façon ne sont pas égales (je travaille avec les deux dates =16/12/20)
Je joins une impression d'écran.
Merci par avance

procedure ComptageNbreDeLignesAInserer.png

chris4785478547 · 21 Décembre 2020

Merci les gars pour vos efforts, mais je continue à galérer, en fait, plus ça va moins je comprends. Je ne sais pas si c'est moi mais j'ai l'impression que vba est très bien à part pour les formats (date notamment) ça m'a l'air d'être un peu le bordel...
Il faut encore que j'assimile le dernier message de Staple mais en attendant, je vais vous envoyer tout ce que j'ai.

Pourquoi DateDebut et DateFin sont égaux ? Parce que mon fichier de données est volumineux et que je souhaitais avoir un nbre de lignes à insérer raisonnable, en l'occurrence: 4 lignes juste pour tester la procédure
NbreDeLignesAInserer

chris4785478547 · 21 Décembre 2020

Et mes procédures...

VB:

Public DateEnCours, DateDebut, DateFin, DateDebutBanque, DateFinBanque, Sélection_dates As String
Public rep, LigneDebutSource, LigneDebutCible, L As Long
Public erreur As Boolean
Public NbreDeLignesAInserer As Long
Public DateLueSource As String
Public a, b As Range
Public LigneECSource, LigneECCible As Long
Public DateDebutNumerique, DateFinNumerique As Long

Public NbreDeLignesAEffacer, NbreDeLignesDansLaVersion, DerniereLigneOccuppee As Long



Sub ValidationDates()


  
    rep = MsgBox("Votre banque vous propose l'importation de vos opérations entre le" & DateDebut & " et le " & DateFin & " Ces dates vous conviennent-elles ?", vbYesNo, Sélection_dates)

    If rep = vbNo Then
        erreur = True
        While erreur
        erreur = False
            
            'Sheets("Feuil8").Activate
            
             DateDebut = InputBox("Choisissez votre date de DEBUT importation au format jj/mm/aa entre le " & DateDebutBanque & " et le " & DateFinBanque)
           ' Range("C1") = "Choisissez votre date de DEBUT importation entre le " & DateDebutBanque & " et le " & DateFinBanque
           ' DateDebut = Range("B2")
            If Int(CDate(DateDebut)) < Int(CDate(DateDebutBanque)) Or Int(CDate(DateDebut)) > Int(CDate(DateFinBanque)) Then
                erreur = True
            End If
        Wend
        
        erreur = True
        While erreur
            erreur = False
           ' Sheets("Feuil9").Activate
            
            DateFin = InputBox("Choisissez votre date de FIN importation au format jj/mm/aa entre le " & DateDebut & " et le " & DateFinBanque)
         '   Range("C1") = "Choisissez votre date de FIN importation entre le " & DateDebut & " et le " & DateFinBanque
          '  DateFin = Range("B2")
            If Int(CDate(DateFin)) < Int(CDate(DateDebutBanque)) Or Int(CDate(DateFin)) > Int(CDate(DateFinBanque)) Or Int(CDate(DateFin)) < Int(CDate(DateDebut)) Then
                erreur = True
            End If
        Wend
    End If
        
  
    If rep = vbYes Then
   ' en développement
    End If
  
End Sub




Sub ComptageNbreDeLignesAInserer()
  Const DateDebut As Date = #12/16/2020#
  Const DateFin As Date = #12/16/2020#
  Dim DateLueSource As Date, LigneEnCours%, NbreDeLignesAInserer%
  With Sheets("Feuil1")
    For LigneEnCours = 3 To 1000
        DateLueSource = CDate(Cells(LigneEnCours, 1))
        
        If DateLueSource >= DateDebut And DateLueSource <= DateFin Then
            NbreDeLignesAInserer = NbreDeLignesAInserer + 1
        End If
    Next LigneEnCours
  End With
  MsgBox "NbreDeLignesAInserer = " & NbreDeLignesAInserer
End Sub



Sub EffacerLignes()

NbreLignesEffacees = 0
While NbreLignesEffacees <> NbreLignesAEffacer
    Call SupprimerUneLigne
    NbreLignesEffacees = NbreLignesEffacees + 1
Wend

End Sub
Sub SupprimerUneLigne()

Range("I6") = Range("I6") - Range("B7") + Range("C7")
Range("A7:H7").ClearContents
classer_lignes

End Sub



Sub Prélevement_auto()
 


    Call classer_lignes
    Sheets("SAISIE_COMPTES").Select
    DerniereLigneOccupee = Range("O1007")
    NombreDeLignesAEffacer = Range("P2") - (Range("Q2") - DerniereLigneOccupee)
    If (NombreDeLignesAEffacer > 0) Then
        For i = 7 To 7 + NombreDeLignesAEffacer - 1
        SupprimerUneLigne
        Next i
    End If
    
    
    Sheets("PRELEVEMENTS AUTO").Select
    Range("A1:E" & Range("F25")).Copy
  
    Sheets("SAISIE_COMPTES").Select
    Range("A7").End(xlDown).Offset(1, 0).Select
    
    Set Dest = Selection
    
    Dest.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    
End Sub

Sub classer_lignes()

    
Worksheets("SAISIE_COMPTES").Range("A7:H" & Range("Q3")).Sort Key1:=Range("A7"), Order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo


End Sub




Sub ComptageNbreDeLignesAEffacer()

NbreDeLignesDansLaVersion = Workbooks("essai.xlsm").Worksheets("SAISIE_COMPTES").Range("Q2").Value
DerniereLigneOccuppee = Workbooks("essai.xlsm").Worksheets("SAISIE_COMPTES").Range("O1007").Value
NbreDeLignesAEffacer = NbreDeLignesAInserer - (NbreDeLignesDansLaVersion - DerniereLigneOccuppee)

End Sub

Sub ImporterCompteBancaire()

   ' Workbooks.Open Filename:="C:\Users\Utilisateur\Desktop\Banque.csv"
    'ActiveWorkbook.SaveAs Filename:="C:\Users\Utilisateur\Desktop\Banque.xlsx"
    
    
    DateDebutBanque = Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("B1").Value
    DateFinBanque = Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("C1").Value
    SélectionDates = "Sélection_dates"
    
    DateDebut = DateDebutBanque
    DateFin = DateFinBanque
  
  
    
    
    Call ValidationDates
    Call ComptageNbreDeLignesAInserer
    Call ComptageNbreDeLignesAEffacer
    Call EffacerLignes
    
    LigneECCible = Workbooks("essai.xlsm").Worksheets("SAISIE_COMPTES").Range("O1007").Value + 1
    LigneECSource = 3
    Call ImporterLignes
    
    'Workbooks.Close Filename:="C:\Users\Utilisateur\Desktop\Banque.csv"
    'Workbooks.Close Filename:="C:\Users\Utilisateur\Desktop\Banque.xlsx"
  
End Sub


Sub ImporterLignes()

DateLue = Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("A" & LigneECSource).Value
While (Int(CDate(DateFin)) >= Int(CDate(DateLue)) >= Int(CDate(DateDebut)))
  
    Range("A" & LigneECCible) = Range("A" & LigneECSource) 'Importation date
    
    Range("F" & LigneECCible) = Range("B" & LigneECSource) 'Importation libellés
    
    If Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("C" & LigneECSource).Value >= 0 Then
        Workbooks("essai.xlsm").Worksheets("Feuille1").Range("C" & LigneECCible).Value = Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("C" & LigneECSource).Value
    Else
        Workbooks("essai.xlsm").Worksheets("Feuille1").Range("B" & LigneECCible).Value = -Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("C" & LigneECSource).Value
    End If
    
    LigneECSource = LigneECSource + 1
    LigneECCible = LigneECCible + 1
    DateLue = Workbooks("Banque.xlsx").Worksheets("Feuille1").Range("A" & LigneECSource).Value
Wend
  
End Sub

Si j'ai oublié quelque chose, dites le moi...

chris4785478547 · 22 Décembre 2020

Toutes mes excuses, ça ne marche toujours pas mais J'avais différentes erreurs:
- je marquais worksheets au lieu de sheets
- et mon fichier .CSV comportait au départ une feuille nommée "banque" que j'avais renommée "Feuil1"
mais je ne sais pas par quelle opération, cette feuille redevenait toujours "banque", comme si je n'avais pas enregistré la modif. Du coup, j'ai modifié dans le programme et remplacé partout par sheets("Banque")
Voici le tout corrigé:

VB:

Public DateEnCours, DateDebut, DateFin, DateDebutBanque, DateFinBanque, Sélection_dates As String
Public rep, LigneDebutSource, LigneDebutCible, L As Long
Public erreur As Boolean
Public NbreDeLignesAInserer As Long
Public DateLueSource As String
Public a, b As Range
Public LigneECSource, LigneECCible As Long
Public DateDebutNumerique, DateFinNumerique As Long

Public NbreDeLignesAEffacer, NbreDeLignesDansLaVersion, DerniereLigneOccuppee As Long



Sub ValidationDates()


  
    rep = MsgBox("Votre banque vous propose l'importation de vos opérations entre le" & DateDebut & " et le " & DateFin & " Ces dates vous conviennent-elles ?", vbYesNo, Sélection_dates)

    If rep = vbNo Then
        erreur = True
        While erreur
        erreur = False
            
            'Sheets("Feuil8").Activate
            
             DateDebut = InputBox("Choisissez votre date de DEBUT importation au format jj/mm/aa entre le " & DateDebutBanque & " et le " & DateFinBanque)
           ' Range("C1") = "Choisissez votre date de DEBUT importation entre le " & DateDebutBanque & " et le " & DateFinBanque
           ' DateDebut = Range("B2")
            If Int(CDate(DateDebut)) < Int(CDate(DateDebutBanque)) Or Int(CDate(DateDebut)) > Int(CDate(DateFinBanque)) Then
                erreur = True
            End If
        Wend
        
        erreur = True
        While erreur
            erreur = False
           ' Sheets("Feuil9").Activate
            
            DateFin = InputBox("Choisissez votre date de FIN importation au format jj/mm/aa entre le " & DateDebut & " et le " & DateFinBanque)
         '   Range("C1") = "Choisissez votre date de FIN importation entre le " & DateDebut & " et le " & DateFinBanque
          '  DateFin = Range("B2")
            If Int(CDate(DateFin)) < Int(CDate(DateDebutBanque)) Or Int(CDate(DateFin)) > Int(CDate(DateFinBanque)) Or Int(CDate(DateFin)) < Int(CDate(DateDebut)) Then
                erreur = True
            End If
        Wend
    End If
        
  
    If rep = vbYes Then
   ' en développement
    End If
  
End Sub




Sub ComptageNbreDeLignesAInserer()
  Const DateDebut As Date = #12/16/2020#
  Const DateFin As Date = #12/16/2020#
  Dim DateLueSource As Date, LigneEnCours%, NbreDeLignesAInserer%
  With Sheets("Banque")
    For LigneEnCours% = 3 To 1000
        DateLueSource = CDate(Cells(LigneEnCours%, 1))
        
        If DateLueSource >= DateDebut And DateLueSource <= DateFin Then
            NbreDeLignesAInserer% = NbreDeLignesAInserer% + 1
        End If
    Next LigneEnCours%
  End With
  MsgBox "NbreDeLignesAInserer = " & NbreDeLignesAInserer%
End Sub



Sub EffacerLignes()

NbreLignesEffacees = 0
While NbreLignesEffacees <> NbreLignesAEffacer
    Call SupprimerUneLigne
    NbreLignesEffacees = NbreLignesEffacees + 1
Wend

End Sub
Sub SupprimerUneLigne()

Range("I6") = Range("I6") - Range("B7") + Range("C7")
Range("A7:H7").ClearContents
classer_lignes

End Sub



Sub Prélevement_auto()
 


    Call classer_lignes
    Sheets("SAISIE_COMPTES").Select
    DerniereLigneOccupee = Range("O1007")
    NombreDeLignesAEffacer = Range("P2") - (Range("Q2") - DerniereLigneOccupee)
    If (NombreDeLignesAEffacer > 0) Then
        For i = 7 To 7 + NombreDeLignesAEffacer - 1
        SupprimerUneLigne
        Next i
    End If
    
    
    Sheets("PRELEVEMENTS AUTO").Select
    Range("A1:E" & Range("F25")).Copy
  
    Sheets("SAISIE_COMPTES").Select
    Range("A7").End(xlDown).Offset(1, 0).Select
    
    Set Dest = Selection
    
    Dest.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    
End Sub

Sub classer_lignes()

    
Worksheets("SAISIE_COMPTES").Range("A7:H" & Range("Q3")).Sort Key1:=Range("A7"), Order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo


End Sub




Sub ComptageNbreDeLignesAEffacer()

NbreDeLignesDansLaVersion = Workbooks("essai.xlsm").Worksheets("SAISIE_COMPTES").Range("Q2").Value
DerniereLigneOccuppee = Workbooks("essai.xlsm").Worksheets("SAISIE_COMPTES").Range("O1007").Value
NbreDeLignesAEffacer = NbreDeLignesAInserer - (NbreDeLignesDansLaVersion - DerniereLigneOccuppee)

End Sub

Sub ImporterCompteBancaire()

     Workbooks.Open Filename:="C:\Users\Utilisateur\Desktop\Banque.CSV"
     ActiveWorkbook.SaveAs Filename:="C:\Users\Utilisateur\Desktop\Banque.xlsx"
    
    
    DateDebutBanque = Workbooks("Banque.xlsx").Sheets("Banque").Range("B1").Value
    DateFinBanque = Workbooks("Banque.xlsx").Sheets("Banque").Range("C1").Value
    SélectionDates = "Sélection_dates"
    
    DateDebut = DateDebutBanque
    DateFin = DateFinBanque
  
  
    
    
    Call ValidationDates
    Call ComptageNbreDeLignesAInserer
    Call ComptageNbreDeLignesAEffacer
    Call EffacerLignes
    
    LigneECCible = Workbooks("essai.xlsm").Sheets("SAISIE_COMPTES").Range("O1007").Value + 1
    LigneECSource = 3
    Call ImporterLignes
    
    'Workbooks.Close Filename:="C:\Users\Utilisateur\Desktop\Banque.csv"
    'Workbooks.Close Filename:="C:\Users\Utilisateur\Desktop\Banque.xlsx"
  
End Sub


Sub ImporterLignes()

DateLue = Workbooks("Banque.xlsx").Sheets("Banque").Range("A" & LigneECSource).Value
While (Int(CDate(DateFin)) >= Int(CDate(DateLue)) >= Int(CDate(DateDebut)))
  
    Range("A" & LigneECCible) = Range("A" & LigneECSource) 'Importation date
    
    Range("F" & LigneECCible) = Range("B" & LigneECSource) 'Importation libellés
    
    If Workbooks("Banque.xlsx").Sheets("Banque").Range("C" & LigneECSource).Value >= 0 Then
        Workbooks("essai.xlsm").Sheets("Banque").Range("C" & LigneECCible).Value = Workbooks("Banque.xlsx").Sheets("Banque").Range("C" & LigneECSource).Value
    Else
        Workbooks("essai.xlsm").Sheets("Banque").Range("B" & LigneECCible).Value = -Workbooks("Banque.xlsx").Sheets("Banque").Range("C" & LigneECSource).Value
    End If
    
    LigneECSource = LigneECSource + 1
    LigneECCible = LigneECCible + 1
    DateLue = Workbooks("Banque.xlsx").Sheets("Banque").Range("A" & LigneECSource).Value
Wend
  
End Sub

Bon courage !

Staple1600 · 22 Décembre 2020

Bonjour le fil

chris4785478547 à dit:
Il faut encore que j'assimile le dernier message de Staple [...]
[...]Pourquoi DateDebut et DateFin sont égaux ? [...]

=>chris
Puisqu'on n'avait pas ton fichier exemple, j'ai fait mon test comme suit:
Dans une feuille, j'ai mis des dates dans la colonne A (en A1 : TEST )
Ensuite j'ai copié 5 fois le 16/12/2020 dans cette colonne
J'ai utilisé le filtre automatique qui donc renvoie 5 occurences
J'ai ensuite testé le code du message#13 (qui renvoie également 5)
Puis j'écrit la macro du message#15 qui renvoie aussi 5.
Donc si il s'agit de compter dans la colonne A combien de cellules sont égales à une date donnée, tu peux t'épargner une boucle.
La syntaxe avec Application.CountIf te suffira (et devrait être plus rapide)
Fais le test sur une colonne avec beaucoup de dates en colonne A
(pas sur ton fichier, mais sur un fichier de test) et redis-moi si c'est le cas ou pas.

Staple1600 · 22 Décembre 2020

Re

=>chris
Je t'ai préparé un code tout prêt pour faire le test
(ici sur 10000 lignes)
1) Tu lances sur une feuille vierge la macro: CREATION_TEST
2) Puis tu lances la macro Test_ComptageLignes.
Chez moi, la MsgBox s'affiche instantanément.

VB:

Sub CREATION_TEST()
[A1] = "TEST": [A2] = #12/13/2020#: [A2:A10000].DataSeries
Cells(Application.RandBetween(8, 17), 1).Value = #12/16/2020#
Cells(Application.RandBetween(19, 23), 1).Value = #12/16/2020#
Cells(Application.RandBetween(37, 43), 1).Value = #12/16/2020#
Cells(Application.RandBetween(72, 77), 1).Value = #12/16/2020#
End Sub
Sub Test_ComptageLignes()
ComptageLignes #12/16/2020#
End Sub
Private Sub ComptageLignes(vDate As Date)
MsgBox Application.CountIf(Range("A:A"), vDate)
End Sub

chris4785478547 · 22 Décembre 2020

Bonjour le fil, Staple, Soan,

=>Staple,

Mince alors !
Tu as raison le code de Soan fonctionne (j'ai re tresté le code du message #13)

Comme tu peux le voir dans les procédures que j'ai fournies, j'avais bien pris ce message en compte, mieux, j'avais pompé la procédure intégrale...Mais j'avais des erreurs (maintenant je ne sais plus lesquelles) alors j'ai tatonné, j'ai pensé que le % manquait à la fin des variables puis ...l'histoire de sheets, worksheets.

Bref j'ai fait le con (parce que j'ai merdouillé alors que j'avais entre les mains un code qui marchait super). Merci les gars !
Ou plutôt: MERCI LES GARS !
Mais évidemment j'ai déja le prochain sujet à proposer.
Je vais cloturer ce sujet
Bonne journée à vous et je souhaite à mon tour d'excellentes fêtes de fin d'année à tous !

Staple1600 · 22 Décembre 2020

Re,

=>chris
Le code du message#13 fonctionne
(Mais cela on le savait déjà, car en général les répondeurs publient des code VBA fonctionnels sur le forum

(Par contre les "demandeurs" peuvent faire des erreurs de copier/coller quand ils reprennent les codes postés sur XLD)

Mais est-ce que tu as pris de tester le code du message#20 que j'ai concocté spécialement à ton attention?
J'attendais le résultat de ton test?
En terme de rapidité d'exécution, un code sans boucle sera plus rapide.
C'est pour ce que je te conseille quand tu le peux de faire des codes sans boucles.
En espérant que tu repasseras me donner le résultat de ton test.
Sinon bonnes fêtes également.

chris4785478547 · 22 Décembre 2020

=> Staple
J'allais oublier ! Un grand merci à toi de t'être donné la peine de me faire une procédure perso
ok je m'y mets de suite, d'autant plus que cela redéconne (désolé) je ne crois pas avoir changé quelque chose mais là je n'ai plus d'incrémentation du nombre de lignes à insérer.
En mode debug j'ai vu que DatelueSource est à 0 avec le format: 00:00:00 je joins une copie d'écran

Staple1600 · 22 Décembre 2020

Re

Rappel
Mon petit test (celui du message#20) est à faire sur un classeur vierge
Et le mode opératoire est expliqué dans le message#20

chris4785478547 · 22 Décembre 2020

Parfait Dr Staple !
En effet, ca marche aussi, il me reste à voir si:
-j'arrive à comprendre ton code plutôt que de le reprendre bêtement (dans le cas contraire, je viendrai t'interroger)
-à l'adapter dans mon programme
-et à comprendre pourquoi désormais j'ai un DatelueSource à 00:00:00 (message#23)
A suivre...

Staple1600 · 22 Décembre 2020

Re

=>chris
Ma question était surtout si tu constates une différence de vitesse d'exécution?
Ce afin que tu te rendes compte par toi même qu'une boucle peut être longue à "se faire".

Staple1600 · 22 Décembre 2020

Re

=>chris
Je viens de faire le test sur 100 000 lignes
Résultat
• Temps de traitement : 3398ms
( avec la macro avec une boucle (For LigneEnCours...Next)

•Temps de traitement : 1328ms (avec Application.CountIf)

NB: Si tu veux tester la version Boucle avec 100 000 lignes
Il faut modifier les déclarations et les passer en Long
(actuellement elles sont en Integer)
Dim DateLueSource As Date, LigneEnCours&, NbreDeLignesAInserer&

Staple1600 · 22 Décembre 2020

chris4785478547 à dit:
Parfait Dr Staple !
En effet, ca marche aussi, il me reste à voir si:
-j'arrive à comprendre ton code plutôt que de le reprendre bêtement (dans le cas contraire, je viendrai t'interroger)

j'espère bien
C'est ce que tout demandeur AOC devrait faire toujours et encore:
• Etre curieux, tester, échouer et revenir poster des questions

EDITION: Etre attentif aussi
On pouvait lire dans le message#14, le conseil suivant
DateLueSource = CDate(Cells(LigneEnCours, 1))
Qu'apparemment on ne retrouve pas sur la copie écran du message#23

chris4785478547 · 22 Décembre 2020

C'est vrai que le traitement est vraiment plus rapide
ICODE]
DateLueSource = CDate(Cells(LigneEnCours, 1))
[/ICODE] =>
En effet, parce que j'ai aussi essayé et que cela ne marchait pas non plus alors je suis revenu aux sources.
Attention, je ne dis pas que cela ne marche pas dans le cas général, mais chez moi il y a quelque chose qui foire. Par exemple, à un moment j'ai réactivé les deux premières lignes de ma proc "ImporterCompteBancaire" (actuellement en commentaire) et ca a été un carnage, en clair, je n'avais même plus les dates proposées par la banque nettes, il y avait comme un mélange des colonnes et quand j'ai vérifié le fichier "Banque.xlsx", effectivement, il s'etait passé qqchose: j'avais dans la même colonne la date et le libellé !
Je ne vais peut être pas tester la version 100000 lignes, je suis convaincu.
Au fait je n'ai pas trouvé le mode "citation" ici

Staple1600 · 22 Décembre 2020

Re

Pour le mode citation, c'est la balise BBCode
[QUOTE]Je cite, tu cites, elle cite[/QUOTE]
ce qui donne l'affichage suivant

Je cite, tu cites, elle cite

XL 2019 Comment comparer 2 dates vba

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums