suppression de lignes entre deux dates

  • Initiateur de la discussion Initiateur de la discussion loic38
  • 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 !

L

loic38

Guest
bonsoir à tous et merci à ceux qui prendront le temps de parcourir ce fil (et d'y répondre)
je voudrais faire une macro avec deux inputbox successives dans lesquelles l'utilisateur saisirait une date de début et de fin de période

les dates en question sont sur la colonne D


ensuite sur une feuille toutes les dates en dehors de ces deux limites seraient supprimées de sorte que celles contenues à l'intérieur susbisteraient

merci de votre aide
 
Bonsoir Loic, le Forum.


Ci-joint un exemple pouvant illustrer ce que tu souhaites...

Sub SupprDate()
Dim TabTemp As Variant
Dim L As Long
Dim S As Long
Dim R As Variant
Dim B1 As Date, B2 As Date
'Demande les bornes
On Error GoTo Fin
R = Application.InputBox("Date de Début :", "Entrez les bornes", Format(Date, "dd/mm/yy"), , , , , 2)
B1 = DateValue(R)
R = Application.InputBox("Date de Fin :", "Entrez les bornes", Format(Date, "dd/mm/yy"), , , , , 2)
B2 = DateValue(R)
On Error GoTo 0
If B2 < B1 Then GoTo Fin
'Mémorise la colonne de dates dans un tableau variant temporaire
With ActiveSheet
L = .Range("D65536").End(xlUp).Row
TabTemp = .Range(.Cells(1, 4), .Cells(L, 4)).Value
'Pour chaque date
For L = UBound(TabTemp, 1) To 1 Step -1
If IsDate(TabTemp(L, 1)) Then
Select Case TabTemp(L, 1)
Case Is < B1, Is > B2
If S = 0 Then .Cells(L, 1).Select
Union(Selection, .Rows(L).EntireRow).Select
S = S + 1
End Select
End If
Next L
If MsgBox(S & " lignes seront supprimées" & vbCrLf & vbCrLf & "Souhaitez-vous continuer ?", _
vbYesNo, "myDearFriend!") = vbYes Then
Selection.Delete
End If
End With
Exit Sub
Fin:
MsgBox "Date(s) incohérente(s) !"
End Sub



Cordialement,
Didier_mDF

myDearFriend-3.gif
 

Pièces jointes

- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Retour