请教老师：用代码进行多表数据匹配汇总，谢谢！

ak47ok · 发表于 2015-9-4 09:07

本帖最后由 ak47ok 于 2015-9-4 10:59 编辑

如题、详见附件，有劳高手！

求VBA：

根据本表A列及第1行的内容，在表一、二、三中各自匹配值求和到黄色范围。

各表里的名称已是不重复的、固定的列数相同，第1行的数字排行顺序相同

应用时也是汇总三个表的数据，但每个表的都超过8万行，且每个名称都达50个字符

在9楼重新上了仿真附件，

谢谢！

KCFONG · 发表于 2015-9-4 09:28

see if help you

huang1314wei · 发表于 2015-9-4 09:40

Sub text()
Dim arr, brr, crr, i%, j%, x%, str, d
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
ReDim brr(1 To 100, 1 To 11)
For Each str In Array("一", "二", "三")
arr = Worksheets(str).Range("C1").CurrentRegion
For i = 2 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
j = j + 1
d(arr(i, 1)) = j
brr(j, 1) = arr(i, 1)
For x = 3 To UBound(arr, 2)
brr(j, x - 1) = arr(i, x)
Next
Else
For x = 3 To UBound(arr, 2)
brr(d(arr(i, 1)), x - 1) = brr(d(arr(i, 1)), x - 1) + arr(i, x)
Next
End If
Next
Erase arr
Next
crr = Range("A1").CurrentRegion
For i = 2 To UBound(crr)
For j = 1 To UBound(brr)
If crr(i, 1) = brr(j, 1) Then
For x = 3 To UBound(crr, 2)
crr(i, x) = brr(j, x - 1)
Next
End If
Next
Next
Range("A1").CurrentRegion = crr
Application.ScreenUpdating = True
End Sub

复制代码

huang1314wei · 发表于 2015-9-4 09:42

附件参考

用代码汇总.rar (17.58 KB, 下载次数: 18)

ak47ok · 发表于 2015-9-4 10:09

KCFONG 发表于 2015-9-4 09:28
see if help you

感谢版主帮助！！
应用是出现
错误13 ：类型不匹配
出现在以下代码
dic(Y) = dic(Y) + Rng(r, c)

谢谢！

ak47ok · 发表于 2015-9-4 10:20

huang1314wei 发表于 2015-9-4 09:40

感谢老师帮助！！
应用中还是出现问题，
错误6：溢出
应用时也是汇总三个表的数据，但每个表的都超过8万行，且每个名称都达50个字符，不知是否与这些有关？

谢谢！

huang1314wei · 发表于 2015-9-4 10:30

ak47ok 发表于 2015-9-4 10:20
感谢老师帮助！！
应用中还是出现问题，
错误6：溢出

上传附件的时候，别模拟数据，最好是上传真实表格，不能上传真实表格的，要注明真实表格的数据结构
至于溢出，应该跟brr数组大小相关，把ReDim brr(1 To 100, 1 To 11) 改成 redim brr(1 to 20000,1 to 11)试试，如果还是溢出，把20000再改大点，改成100000

ak47ok · 发表于 2015-9-4 10:40

本帖最后由 ak47ok 于 2015-9-4 11:04 编辑

huang1314wei 发表于 2015-9-4 10:30
上传附件的时候，别模拟数据，最好是上传真实表格，不能上传真实表格的，要注明真实表格的数据结构
至于 ...

实例附件太大，上传不方便
没有上全真附件是想自己通过修改老师的代码来自己学习下。
我已是ReDim brr(1 To 1000000, 1 To 11)

谢谢！

ak47ok · 发表于 2015-9-4 10:55

huang1314wei 发表于 2015-9-4 10:30
上传附件的时候，别模拟数据，最好是上传真实表格，不能上传真实表格的，要注明真实表格的数据结构
至于 ...

谢谢老师提醒，重新上了仿真附件。麻烦老师再次指导，谢谢！

huang1314wei · 发表于 2015-9-4 11:22

ak47ok 发表于 2015-9-4 10:55
谢谢老师提醒，重新上了仿真附件。麻烦老师再次指导，谢谢！

代码已修正，请查阅

用代码汇总仿真.rar (248.2 KB, 下载次数: 33)

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

[求助] 请教老师：用代码进行多表数据匹配汇总，谢谢！

评分

评分

最新热点 /1