汇总文件夹下分表的数据

yrjgoodluck666

iwangyi 发表于 2018-8-30 21:37
Sub 多表汇总()
Set FSO = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
Set FF = FSO.GETFOLDER(ThisWor ...

下标越界，不知是哪里要改

yrjgoodluck666

lsc900707 发表于 2018-8-30 23:04
Sub test()
    Dim arB(1 To 10000, 1 To 6)
    p = ThisWorkbook.Path & "\"

测试成功，非常感谢！努力学习！！

yrjgoodluck666

lsc900707 发表于 2018-8-30 23:04
Sub test()
    Dim arB(1 To 10000, 1 To 6)
    p = ThisWorkbook.Path & "\"

您好！现在运行代码会出现：打开EXCEL时提示此工作薄包含到其它数据源的链接，提示更新或不更新，数据获取不到，请问该如何解决，谢谢！

lsc900707

yrjgoodluck666 发表于 2018-9-11 22:37
您好！现在运行代码会出现：打开EXCEL时提示此工作薄包含到其它数据源的链接，提示更新或不更新，数据获 ...

上传出错的附件看看。

lsc900707

yrjgoodluck666 发表于 2018-9-11 22:37
您好！现在运行代码会出现：打开EXCEL时提示此工作薄包含到其它数据源的链接，提示更新或不更新，数据获 ...

结合新附件要求，修改代码如下：
Sub test()
    Dim arB(1 To 10000, 1 To 10)
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xlsx")
    Application.ScreenUpdating = False
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(p & f)
            With wb.Sheets("工资表")
                r = .Cells(.Rows.Count, 1).End(3).Row
                arA = .Range("a1:av" & r)
                n = n + 1
                arB(n, 1) = n
                arB(n, 2) = Replace(Split(f, ".")(0), "工资表", "")
                For i = 2 To UBound(arA)
                    arB(n, 3) = arB(n, 3) + arA(i, 40)
                    arB(n, 4) = arB(n, 4) + arA(i, 48)
                    If InStr(arA(i, 13), "自离") = 0 Then
                        For j = 5 To 9
                            arB(n, j) = arB(n, j) + arA(i, j + 35)
                        Next
                        arB(n, 10) = arB(n, 10) + arA(i, 48)
                    End If
                Next
            End With
            wb.Close False
        End If
        f = Dir
    Loop
    Set wb = Nothing
    With Sheet1
        .[a1].CurrentRegion.Offset(1).ClearContents
        .[a2].Resize(n, 10) = arB
    End With
    Application.ScreenUpdating = True
    MsgBox "ok!"
End Sub