请教用VBA进行数据的提取并汇总

hxgfkfb · 发表于 2018-1-2 13:17

本帖最后由 hxgfkfb 于 2018-3-23 09:43 编辑

数据.rar (61.22 KB, 下载次数: 12)

liyizhe000 · 发表于 2018-1-2 17:03

本帖最后由 liyizhe000 于 2018-1-2 17:08 编辑

QQ联系我

grf1973 · 发表于 2018-1-2 20:24

练练手，省得生疏了。

Sub 汇总()
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 6)
For i = 2 To UBound(arr)
bh = arr(i, 8)
If Not d.exists(bh) Then
n = n + 1: d(bh) = n
brr(n, 1) = arr(i, 1)
brr(n, 2) = bh
brr(n, 3) = arr(i, 9)
brr(n, 4) = arr(i, 10)
brr(n, 5) = arr(i, 11)
brr(n, 6) = arr(i, 15)
Else
p = d(bh)
If InStr(brr(p, 5), arr(i, 11)) = 0 Then brr(p, 5) = brr(p, 5) & "," & arr(i, 11)
brr(p, 6) = brr(p, 6) + arr(i, 15)
End If
Next
With Sheet2
.[a2].Resize(1000, 10).ClearContents
.[a2].Resize(n, 6) = brr
End With
End Sub

复制代码

wjpjinan · 发表于 2018-8-6 15:35

抱歉，该附件无法读取什么意思？

gb168 · 发表于 2018-8-7 16:12

虽然我看不懂，感觉这种写法的运行速度很快

kszcs · 发表于 2020-1-26 17:53

谢谢大师，下载

		自动登录	找回密码
密码			注册