XL 2016 Nombre d'occurrence avec condition

Private Sub Worksheet_Activate()
Worksheet_Change [A1]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim an, mois, sem, tablo, resu(), d As Object, i&, x$, n&, nn&
an = [B1]: If an = "" Then an = "*"
mois = [D1]: If mois = "" Then mois = "*"
sem = [F1]: If sem = "" Then sem = "*"
tablo = Sheets("BDD").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
    If tablo(i, 3) Like an And tablo(i, 4) Like mois And tablo(i, 5) Like sem Then
        x = tablo(i, 1) & tablo(i, 6)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, 6)
        End If
        nn = d(x)
        resu(nn, 3) = resu(nn, 3) + 1 'compte
    End If
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData
With [A4] '1ère cellule de destination
    If n Then
        .Resize(n, 3) = resu
        .Sort .Columns(1), xlAscending, .Columns(2), , xlAscending, Header:=xlYes
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub