Private Sub Worksheet_Activate()
Dim celdest As Range, t, rest(), n&, i&
Set celdest = [B2] 'la cellule qu'on veut...
Application.ScreenUpdating = False
celdest.EntireColumn.Insert 'ajout d'une colonne auxiliaire
With Sheets("BD").[A1].CurrentRegion
celdest(, 0).Resize(.Rows.Count) = .Columns(1).Value 'dates
celdest.Resize(.Rows.Count) = .Columns(3).Value 'noms
'tri sur les noms puis décroissant sur les dates
celdest(, 0).Resize(.Rows.Count, 2).Sort celdest, , , celdest(, 0), xlDescending, Header:=xlYes
t = celdest(, 0).Resize(.Rows.Count, 2) 'matrice, plus rapide
End With
ReDim rest(1 To UBound(t), 1 To 3)
rest(1, 2) = "NOM": rest(1, 3) = "NOMBRE"
n = 1
For i = 2 To UBound(t)
If t(i, 2) <> "" Then
If t(i, 2) <> t(i - 1, 2) Then
n = n + 1
rest(n, 1) = t(i, 1) 'date
rest(n, 2) = t(i, 2) 'nom
rest(n, 3) = 1 'fréquence
Else
rest(n, 3) = rest(n, 3) + 1
End If
End If
Next
With celdest(, 0).Resize(n, 3)
.Value = rest
'tri décroissant sur les nombres puis sur les dates
.Sort celdest(, 2), xlDescending, , celdest(, 0), xlDescending, Header:=xlYes
End With
If n > 21 Then n = 21
celdest(n + 1).Resize(Rows.Count - n - celdest.Row + 1, 2).Delete xlUp
celdest(, 0).EntireColumn.Delete 'mettre en commentaire pour vérifier les dates
t = Me.UsedRange 'repositionne la barre de défilement verticale
End Sub
