一个文件夹下有多个文件，VBA汇总生成一个汇总表

hjq018

A列相同，C列数据相加

hjq018

在线等，有点急，版主大大速来

lsc900707

hjq018 发表于 2018-8-9 16:53
在线等，有点急，版主大大速来

Sub test()
    Set d = CreateObject("Scripting.Dictionary")
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Application.ScreenUpdating = False
    ReDim brr(1 To 10000, 1 To 3)
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set sht = GetObject(p & f).Sheets("Sheet1")
            Arr = sht.UsedRange
            Workbooks(f).Close False
            For i = 1 To UBound(Arr)
                If Not d.exists(Arr(i, 1)) Then
                    m = m + 1: d(Arr(i, 1)) = m
                    For j = 1 To UBound(Arr, 2)
                        brr(m, j) = Arr(i, j)
                    Next
                Else
                    brr(d(Arr(i, 1)), 3) = brr(d(Arr(i, 1)), 3) + Arr(i, 3)
                End If
            Next
        End If
        f = Dir
    Loop
    Set sht = Nothing
    [a1].Resize(m, UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
    MsgBox "汇总完成！"
End Sub

lsc900707

hjq018 发表于 2018-8-9 16:53
在线等，有点急，版主大大速来

代码需要审核，先测试附件：

LMY123

同夹多薄首表 汇总

xiangbaoan

……………………………………

jjmysjg

xiangbaoan 发表于 2018-8-9 18:53
……………………………………

想汇总所有表，怎么改？

hjq018

已经解决了，，谢谢大家