[已解决]请教：统计指定列、数、向下第几个的种类及个数

sam-wang

lygyjt 发表于 2022-6-26 16:48
请老师有空看下，受累了！

不好意思，自己想的太複雜，請再測試看看，謝謝

Sub test()
Dim Arr, xD, Brr, xC%, xN$, xR&, T$, n&, i&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets(2)
    xC = .[b1]: xN = .[b2]: xR = .[b3]
End With
Arr = Sheets(1).[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
    T = Arr(i, xC + 1): If T <> xN Then GoTo 95
    R = i + xR: If R > UBound(Arr) Then GoTo 95
    n = n + 1: Brr(n, 1) = Arr(R, xC + 1)
95: Next
For i = 1 To n: xD(Brr(i, 1) & "") = xD(Brr(i, 1) & "") + 1: Next
With Sheets(2)
    .[d2:e1000] = ""
    .Range("d2:d" & xD.Count).NumberFormatLocal = "@"
    .[d2].Resize(xD.Count, 1) = Application.Transpose(xD.keys)
    With .Range("d2:e" & xD.Count + 1)
        Arr = .Value
        For i = 1 To UBound(Arr): Arr(i, 2) = xD(Arr(i, 1) & ""): Next
        .NumberFormatLocal = "@"
       .Value = Arr
    End With
End With
End Sub

lygyjt

sam-wang 发表于 2022-6-26 19:14
不好意思，自己想的太複雜，請再測試看看，謝謝

Sub test()

答案完全正确。
老师，说不好意思的应该是我。为了我，休息日您都没好好清闲一下。积分没了，要不就悬赏了，嘿嘿。