[已解决]匹配汇总

乐乐2006201506 · 发表于 2016-12-10 20:55

本帖最后由乐乐2006201506 于 2016-12-11 09:40 编辑

附件已上传，汇总表中的姓名所对应的数据，需要从其他几个工作簿中查到，并累计统计，姓名没有的忽略。谢谢各位大师了。

在同一文件夹，用汇总工作簿，遍历搜索并统计其他每个工作簿中（表格结构相同，每簿中不一定都有某人信息，且每簿中某人所在位置是变化的，每簿中人员数量也是变化的）某人所有信息某项的和（本例中统计数据列的值）。望各位大师能够及时帮忙，谢谢啦！

最佳答案

月排行榜 / 总排行榜

雨吧

2016-12-11 08:50

Sub YuBa()
Dim d As Object, arr(1), i&, j&
Dim wk, th, fl
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
th = ThisWorkbook.Path & ""
arr(0) = Sheets(1).UsedRange
For i = 2 To UBound(arr(0))
d(arr(0)(i, 2)) = 0
Next
fl = Dir(th & "*.xlsx")
Do While fl <> ""
If fl <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(th & fl)
arr(1) = Sheets(1).UsedRange
wb.Close
For i = 2 To UBound(arr(1))
If d.exists(arr(1)(i, 2)) Then
d(arr(1)(i, 2)) = d(arr(1)(i, 2)) + arr(1)(i, 3)
End If
Next
End If
fl = Dir
Loop
[c4].Resize(d.Count) = Application.Transpose(d.items)
Application.ScreenUpdating = True
End Sub

复制代码

查找匹配求和.rar (59.71 KB, 下载次数: 13)

雨吧 · 发表于 2016-12-11 08:50

Sub YuBa()
Dim d As Object, arr(1), i&, j&
Dim wk, th, fl
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
th = ThisWorkbook.Path & ""
arr(0) = Sheets(1).UsedRange
For i = 2 To UBound(arr(0))
d(arr(0)(i, 2)) = 0
Next
fl = Dir(th & "*.xlsx")
Do While fl <> ""
If fl <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(th & fl)
arr(1) = Sheets(1).UsedRange
wb.Close
For i = 2 To UBound(arr(1))
If d.exists(arr(1)(i, 2)) Then
d(arr(1)(i, 2)) = d(arr(1)(i, 2)) + arr(1)(i, 3)
End If
Next
End If
fl = Dir
Loop
[c4].Resize(d.Count) = Application.Transpose(d.items)
Application.ScreenUpdating = True
End Sub

复制代码

查找匹配求和.rar (59.71 KB, 下载次数: 13)

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