VBA supprimer des ligne sselon la date d'une cellule

[Scrabblouille]

Bonjour,

Je souhaiterais, dans un tableau trié sur une colonne contenant des dates au format jj/mm/aaaa hh:mm:ss, supprimer les lignes dont la date n'est pas dans un intervalle donné.
Les dates sont choisies par l'utilisateur avec des inputbox.
J'ai imaginé rechercher la 1ère cellule contenant la date de début et supprimer toutes les lignes précédentes, idem pour la date de fin avec les lignes suivantes.
En cherchant sur le net j'ai trouvé que la commande find ne fonctionne qu'avec le format américain (m/d/yy). Ceci est mon 1er pb puisque ma conversion de format ne fonctionne pas si le jour est à 2 chiffres.
Ensuite mon find ne fonctionne pas malgré plusieurs méthodes testées.
Ci-dessous mes codes, si quelqu'un pouvait m'éclairer ce serait sympa.

Debut = InputBox("Quelle est la date de début d'analyse ? (jj/mm/aa)", "Date début")
Fin = InputBox("Quelle est la date de fin d'analyse ? (jj/mm/aa)", "Date fin")
Debut = Format(Debut, "m,d,yy")
Fin = Format(Fin, "m,d,yy")
Set Ligne_debut = [a:a].Find(what:=Debut, LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Address

Cdlt.

 

[Catrice]

Re : VBA supprimer des ligne sselon la date d'une cellule

Bonsoir,

Peu tu fournir un echantillon de données ?

Ci-joint un exemple à tester et à adapter.

Sub test()
Debut = InputBox("Quelle est la date de début d'analyse ? (jj/mm/aa)", "Date début")
Fin = InputBox("Quelle est la date de fin d'analyse ? (jj/mm/aa)", "Date fin")
For Each X In Range("A1:" & Range("A65536").End(xlUp).Address)
    If X >= CDate(Debut) And X <= CDate(Fin) Then X.Clear
Next
End Sub

Je ne vois pas comment tu veux faire avec Find ...

 

[Gorfael]

Re : VBA supprimer des ligne sselon la date d'une cellule

Salut Scrabblouille et le forum
Ce que je comprends :
tu veux saisir 2 dates et ne conserver que ce qui se trouve entre ces deux dates.
Si c'est ça : La méthode find n'est pas une solution : une date est un nombre entier et tes dates sont avec les heures, minutes et secondes : je ne suis pas sûr que même si elle existe, la méthode Find trouve la bonne date. de plus, pour les dates, il faudrait s'assurer que l'on prenne le jour d'avant la date de début et d'après le jour de fin.
D'après les données, sur Excel 2003 èa donnerait :

Sub test()
Dim Debut As Date, Fin As Date
Dim X As Long
Debut = CDate(InputBox("Quelle est la date de début d'analyse ? (jj/mm/aa)", "Date début"))
Fin = CDate(InputBox("Quelle est la date de fin d'analyse ? (jj/mm/aa)", "Date fin")) + 1
For X = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Range("A" & X) < Debut Or Fin <= Range("A" & X) Then Rows(X).Delete
Next X
End Sub

Un problème peut venir des inputbox : il faut donc s'assurer que la date entrée est bien retranscrite dans le bon format : j'ai déjà eu un problème avec une confusion Jour/Mois et Mois/Jour. Mais sur la macro que je viens de tester, ça n'a plus l'air d'être le cas chez moi (mais je ne sais pas pourquoi ).
A+

 

[Scrabblouille]

Re : VBA supprimer des ligne sselon la date d'une cellule

Salut,
Comme mon fichier fait actuellement environ 6000 lignes et augmente en moyenne de 350 lignes par mois je cherchais une solution plus rapide qu'une boucle.
Merci pour vos propositions, je teste demain et vous tient au courant.
A+

 

[Catrice]

Re : VBA supprimer des ligne sselon la date d'une cellule

Bonsoir,

Si tes dates sont triées, tu peux utiliser ce code :

Sub test2()
Debut = InputBox("Quelle est la date de début d'analyse ? (j/m/a)", "Date début")
If Debut = "" Then Exit Sub
Fin = InputBox("Quelle est la date de fin d'analyse ? (j/m/a)", "Date fin")
If Fin = "" Then Exit Sub
Set c1 = ActiveSheet.Columns(1).Find(CDate(Debut), LookIn:=xlValues)
Set c2 = ActiveSheet.Columns(1).Find(CDate(Fin), LookIn:=xlValues)
If Not c1 Is Nothing Or Not c2 Is Nothing Then
    ActiveSheet.Range(c1, c2).EntireRow.Delete
Else
    MsgBox "Une ou les 2 dates n'ont pas été trouvées"
End If
End Sub

Tu peux entrer la date sous la forme :
15/8/9 pour 15/08/2009

Voir fichier joint

 

[Gorfael]

Re : VBA supprimer des ligne sselon la date d'une cellule

Salut Scrabblouille et le forum
Une autre proposition : en partant du principe que la ligne 1 contient des titres :

Sub Macro1()
Dim Debut As Long, Fin As Long
ActiveSheet.AutoFilterMode = False
Debut = CLng(CDate(InputBox("Quelle est la date de début d'analyse ? (jj/mm/aa)", "Date début")))
Fin = 1 + CLng(CDate(InputBox("Quelle est la date de fin d'analyse ? (jj/mm/aa)", "Date fin")))
Range("A1").AutoFilter Field:=1, Criteria1:="<" & Debut
Range([A2], [A2].End(xlDown)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("A1").AutoFilter Field:=1, Criteria1:=">=" & Fin
Range([A2], [A2].End(xlDown)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
End Sub

J'ai eu quelque difficultée avec le filtre : ça pourrait marcher mieux, en le faisant en une seule fois, mais comme je n'y arrive pas, en deux fois.
Testée sur le fichier de Catrice avec un format "jj/mm/aa hh:mm:ss", chez moi ça fonctionne, mais sur un grand fichier...
Pour tester, tu peux passer les lignes de code contenant les .Delete en commentaire et faire un pas à pas => tu pourra vérifier de visu le bon fonctionnement. Mais teste sur une copie de ton fichier, ce serait plus prudent. A+

 

[Scrabblouille]

Re : VBA supprimer des ligne sselon la date d'une cellule

Bonjour,
Ce matin j'ai pu tester la solution livrée par Dead78 sur développez.net et elle semble fonctionner tout à fait correctement. Il me reste à gérer les erreurs pour les dates inexistantes ou présentes sur plusieurs lignes.
Merci beaucoup pour la promptitude de vos réponses.
Je débute en VBA et ai plein d'idées pas toujours faciles à mettre en oeuvre.
Voici la solution que j'ai intégrée dans ma routine

A une prochaine.

Sub test()

Dim Debut As Date
Dim Fin As Date
Dim temp1 As Long
Dim temp2 As Long

Debut = InputBox("Quelle est la date de début d'analyse ? (jj/mm/aa)", "Date début")
Fin = InputBox("Quelle est la date de fin d'analyse ? (jj/mm/aa)", "Date fin")

With Range("a1:a500")
Set c = .Find(Debut)
If Not c Is Nothing Then
temp1 = c.Row
End If
Set d = .Find(Fin, LookIn:=xlValues)
If Not c Is Nothing Then
temp2 = d.Row
End If
End With

Range(Cells(1, 1), Cells(temp1 - 1, 1)).EntireRow.Delete
Range(Cells(temp2, 1), Cells(500, 1)).EntireRow.Delete

End Sub