Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim i As Integer 'déclare la variable i (Incrément)
Dim j As String 'déclare la variable j (Jour)
Dim m As String 'déclare la variable m (Mois)
Dim a As String 'déclare la variable a (Année)
Dim crit As String 'déclare la variable crit (CRITère)
Dim nb As Integer 'déclare la variable nb (NomBre de valeurs)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
With Sheets("Sheet1") 'prend en compte l'onglet "Sheet1"
dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 2(=B)
Set pl = .Range("B2:B" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "Sheet1"
Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
dico(cel.Value) = "" 'alimente le dictionnaire dico
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnaire sans doublons dans le tableau temporaire temp
For i = 0 To UBound(temp, 1) 'boucle sur tous les éléments (uniques) du tableau temp
If temp(i) = Date Then Exit Sub 'si la valeur temp(i) est égale à la date du jour, sort de la procédure
j = CStr(Split(temp(i), "/")(0)) 'définit le jour j
m = CStr(Split(temp(i), "/")(1)) 'définit le mois m
a = CStr(Split(temp(i), "/")(2)) 'définit l'année a
crit = m & "/" & j & "/" & a 'définit le critère crit
Range("A1").AutoFilter 'active le filtre automatique
'filtre la colonne 2 (=B) par rapport au critère crit
Range("A1").AutoFilter Field:=2, Operator:= _
xlFilterValues, Criteria2:=Array(2, crit)
nb = pl.SpecialCells(xlCellTypeVisible).Cells.Count 'définit le nombre de fois que le critère crit apparaît
'si nb est supérieur à deux, supprime toutes les lignes sauf les deux dernières
If nb > 2 Then Range(pl.SpecialCells(xlCellTypeVisible)(1), pl.SpecialCells(xlCellTypeVisible)(nb - 2)).EntireRow.Delete
Range("A1").AutoFilter 'annule le filtre automatique
Next i 'prochain élement de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
