Excel VBA 根据日期汇总统计另一字段非重复值的个数

Sub lqxs()

Dim Arr, i&, x, y, z

Dim d, k, t

Set d = CreateObject("Scripting.Dictionary")
Set s = CreateObject("Scripting.Dictionary")

Sheet1.Activate

[f:g].ClearContents

Arr = [a1].CurrentRegion

For i = 2 To UBound(Arr)

    x = Arr(i, 1): y = Arr(i, 2)
    z = Arr(i, 1)

    If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")

    d(x)(y) = d(x)(y) + 1
s(z) = s(z) + 1
Next

k = d.keys: t = d.items

[f2].Resize(d.Count) = Application.Transpose(k)
[h2].Resize(d.Count) = Application.Transpose(s.items)

For i = 0 To UBound(k)
    Cells(i + 2, 7) = t(i).Count
   
Next

 

End Sub