求助：VBA 快速统计重复值的个数，请老师帮忙指导下，谢谢

excelvlookup

Sub aa()
t = Timer
Dim rw%, i%, j%, k%
Dim ar, br
Dim arr(), cr(), rr()
With Sheets("原始数据")
    rw = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:g" & rw)
    rw = .Cells(Rows.Count, 18).End(xlUp).Row
    br = .Range("r1:w" & rw)
End With
ReDim cr(1 To 100, 1 To 6)
For i = 1 To UBound(br, 2)
    For j = 1 To UBound(br)
        cr(br(j, i), i) = cr(br(j, i), i) + 1
    Next
Next
ReDim arr(1 To UBound(ar), 1 To 6)
For k = 1 To 6
    For i = 1 To UBound(ar)
        ReDim rr(1 To 100)
        For j = 1 To UBound(ar, 2)
            If rr(ar(i, j)) = "" Then
                arr(i, k) = arr(i, k) + cr(ar(i, j), k)
                rr(ar(i, j)) = 1
            End If
        Next
    Next
Next
Sheets("正确示例").Range("i1").Resize(UBound(ar), 6) = arr
MsgBox Timer - t
End Sub