Sub ListeDate()
Dim i%, v$, dPlg, oCel As Range, oPlg As Range
Dim dic As Object, LastLg As Integer
Set dic = CreateObject("Scripting.Dictionary")
LastLg = Range("A" & Rows.Count).End(xlUp).Row
MsgBox "LastLg = " & LastLg
Set oPlg = Range("A1:A" & LastLg) 'plage de données
dPlg = oPlg.Value
'-- Tri
With oPlg.Parent.Sort
.SortFields.Clear
.SortFields.Add Key:=oPlg.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange oPlg
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
On Error Resume Next
'-- Récupérer les dates sans doublons
For Each oCel In oPlg.Cells
MsgBox "oCel = " & oCel & vbCrLf & _
"Left oCel = " & Left(oCel, 10)
dic(oCel.Value) = IIf(dic.Exists(Left(oCel.Value, 10)), dic(Left(oCel.Value, 10)) + 1, 1)
Next oCel
oPlg.Value = dPlg
Set oPlg = Nothing
Erase dPlg
On Error GoTo 0
Sheets("feuil1").Range("B2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
'-- Plage nommée
ActiveWorkbook.Names.Add Name:="MaListe", RefersTo:="=Feuil1!$B$2:$B$" & LastLg & ""
'---------
With [F2].Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=MaListe"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub