自动汇总数据

初学AC

求助，由于数据量巨大，A/B列是原始数据，想得到F/G列的结果，请大神帮忙做一下，谢谢

魂断蓝桥

Sub a()
Dim arr, brr(1 To 999, 1 To 2), i%, m%, d
Set d = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
    If Not d.exists(arr(i, 1)) Then
        m = m + 1
        brr(m, 1) = arr(i, 1)
        brr(m, 2) = arr(i, 2)
        d(arr(i, 1)) = m
    Else
        brr(d(arr(i, 1)), 2) = brr(d(arr(i, 1)), 2) & "/" & arr(i, 2)
    End If
Next
[f17].Resize(m, 2) = brr
Set d = Nothing
End Sub

鄂龙蒙

1. Sub 统计()
   
2.     Dim d, ar, br(), m, i, s
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Range("I2:J10000").ClearContents
   
5.     ar = Range("A1").CurrentRegion
   
6.         For i = 2 To UBound(ar)
   
7.             s = ar(i, 1)
   
8.             If d(s) = "" Then
   
9.                 m = m + 1
   
10.                 ReDim Preserve br(1 To 2, 1 To m)
    
11.                 d(s) = m
    
12.                 br(1, m) = ar(i, 1)
    
13.                 br(2, m) = ar(i, 2)
    
14.             Else
    
15.                 br(2, d(s)) = br(2, d(s)) & "/" & ar(i, 2)
    
16.             End If
    
17.         Next
    
18.     [I2].Resize(m, 2) = Application.Transpose(br)
    
19.    Set d = Nothing
    
20. End Sub

复制代码