XL 2016 Filtre de plusieurs dates et moyenne

Private Sub Worksheet_Activate()
Dim d As Object, dd As Object, tablo, resu(), i&, x, y$, z, a, b, s, n&, nn&
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = [Tableau1] 'matrice, plus rapide, sur tableau structuré
ReDim resu(1 To UBound(tablo), 1 To 5) 'tableau des résultats à 5 colonnes
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    If IsDate(x) Then
        x = CDbl(x)
        y = x & " " & tablo(i, 4) 'concatène date et famille
        z = tablo(i, 2)
        If IsDate(z) Then z = CDbl(z): If z > d(y) Then d(y) = z
        z = tablo(i, 3)
        If IsDate(z) Then z = CDbl(z): If z > dd(y) Then dd(y) = z
    End If
Next i
'---sur D2---
If d.Count Then
    a = d.keys: b = d.items
    d.RemoveAll 'RAZ
    For i = 0 To UBound(a)
        s = Split(a(i)) 's(0) la date, s(1) la famille
        If Not d.exists(s(1)) Then
            n = n + 1
            d(s(1)) = n 'mémorise la ligne
            resu(n, 1) = s(1)
        End If
        nn = d(s(1)) 'récupère la ligne
        resu(nn, 2) = resu(nn, 2) + b(i) - Val(s(0)) 'somme des écarts sur D2
        resu(nn, 4) = resu(nn, 4) + 1 'comptage en 4ème colonne
    Next i
End If
'---sur D3---
If dd.Count Then
    a = dd.keys: b = dd.items
    For i = 0 To UBound(a)
        s = Split(a(i)) 's(0) la date, s(1) la famille
        If Not d.exists(s(1)) Then
            n = n + 1
            d(s(1)) = n 'mémorise la ligne
            resu(n, 1) = s(1)
        End If
        nn = d(s(1)) 'récupère la ligne
        resu(nn, 3) = resu(nn, 3) + b(i) - Val(s(0)) 'somme des écarts sur D3
        resu(nn, 5) = resu(nn, 5) + 1 'comptage en 5ème colonne
    Next i
End If
'---moyennes---
If n Then
    For i = 1 To n
        resu(i, 2) = resu(i, 2) / resu(i, 4)
        resu(i, 3) = resu(i, 3) / resu(i, 5)
    Next i
End If
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub