求助各位大神

'输出全部，用你的慧眼目测一下就可以了
Option Explicit
Sub abc()
　Dim i, j, a, d(1), t
　For i = 0 To UBound(d)
　　Set d(i) = CreateObject("scripting.dictionary")
　Next
　a = [a1].CurrentRegion.Resize(, 3).Value
　For i = 2 To UBound(a)
　　d(0)(a(i, 1)) = d(0)(a(i, 1)) & Space(1) & a(i, 3)
　Next
　For Each i In d(0).keys
　　t = Split(d(0)(i))
　　For j = 1 To UBound(t)
　　　d(1)(t(j)) = 1
　　Next
　　d(0)(i) = d(1).Count: d(1).RemoveAll
　Next
　[e:e].NumberFormatLocal = "yyyy/mm/dd"
　[e2].Resize(d(0).Count, 2) = _
　　Application.Transpose(Array(d(0).keys, d(0).items))
End Sub

Option Explicit
Sub abc()
　Dim i, j, a, d(1), t
　For i = 0 To UBound(d)
　　Set d(i) = CreateObject("scripting.dictionary")
　Next
　a = [a1].CurrentRegion.Resize(, 3).Value
　For i = 2 To UBound(a)
　　d(0)(a(i, 1) & Space(1) & a(i, 2)) = _
　　　d(0)(a(i, 1) & Space(1) & a(i, 2)) & Space(1) & a(i, 3)
　Next
　For Each i In d(0).keys
　　t = Split(d(0)(i))
　　For j = 1 To UBound(t)
　　　d(1)(t(j)) = 1
　　Next
　　d(0)(i) = d(1).Count: d(1).RemoveAll
　Next
　[e:e].NumberFormatLocal = "yyyy/mm/dd"
　[e2].Resize(d(0).Count, 2) = _
　　Application.Transpose(Array(d(0).keys, d(0).items))
End Sub

我觉得PQ稍微学习一下还是挺好用的，比VBA简单，这个例子我只用了一个在PQ里的简单函数，不用VBA那些复杂的东西，一共就写了一句相当简单的代码。缺点就是统计的时候要点一下数据刷新。效果如下图：

=SUM(IFERROR((A2:A99=DATE(2021,11,9)*(B2:B99="羊"))/COUNTIFS(A2:A99,DATE(2021,11,9),B2:B99,"=羊",C2:C99,C2:C99),))
输完公式后，按CTRL+SHIFT+ENTER组合键