用字典夸工作薄汇总求助

tcy119

求助：根据本表AR：AT单元格中（名称，编号，部门）条件到，数据库文件夹中---工作薄<10301预算报表数据库1.0>中，《103020122费用支出明细表二》工作表取数汇总，本表汇总范围E8:AQ60。由于本人是初学字典，不知道如何写代码。谢谢！详见附件。
Sub lqxs()
Dim Arr, i&, x$, y$, Brr 汇总（求助）.rar (55.13 KB, 下载次数: 4)

2017-8-24 12:38 上传

点击文件名下载附件

Dim d, k, t, J%
Dim myPath$, myName$, sh As Worksheet
Set d = CreateObject("Scripting.Dictionary")
myPath = ThisWorkbook.Path & "\数据库\"
    myName = Dir(myPath & "*.xls")
n = 2
Do While myName <> ""
        With GetObject(myPath & myName)
        Set sh = .Sheets(8)
        Arr = sh.Range("a8").CurrentRegion

    For i = 2 To UBound(Arr)
    x = Arr(i, 2): y = Arr(i, 3)
    If d.exists(x) = False Then Set d(x) = CreateObject("Scripting.Dictionary")
    d(x)(y) = d(x)(y) + 1
            Next
            .Close False
        End With

myName = Dir
    Loop
On Error Resume Next
k = d.keys: t = d.items
Sheet8.[E8].Resize(53, 46) = 0
Brr = Sheet8.[a8].CurrentRegion
For i = 2 To UBound(Brr)
    For J = 3 To UBound(Brr, 2)
        x = Brr(i, 45): y = Brr(1, J)
        If d(x).exists(y) Then Cells(i + 2, J) = d(x)(y)
    Next
Next
End Sub

tcy119

请高手帮一帮，原先是用函数的，但运行速度慢，用字典就非常快。谢谢高手了。

tcy119

顶起来，顶起来，顶起来，顶起来，

tcy119

高手们，请帮帮忙。

tcy119

顶顶起来，顶起来

tcy119

大侠们，请帮帮忙啊。

tcy119

在线等啊，捆了很长时间了，等高手出现。

tcy119

顶起来，顶起来