[字典嵌套][三维数组]对结构基本相同、同名工作表列项目不同的多个工作簿按表名汇总

zhaogang1960

请测试：
劳动统计.rar (149.52 KB, 下载次数: 269)

2010-1-4 20:56 上传

点击文件名下载附件

zhaogang1960

为了避免误解，请上传你工作中需要的附件

3abc

老师：汇总时提示“下标越界”是什么意思？只能汇总20个单位。

3abc

老师：汇总时提示“下标越界”是什么意思？只能汇总20个单位。

zhaogang1960

我把分表文件夹中的文件增加到60个，经测试没有问题
我想是你的工作表名称出了问题，要求每个工作簿中只有2个工作表：中学数据表、小学数据表，否则请上传附件看看工作表名的规律

3abc

老师：还是写着“下标越界”，只计到36单位。你有QQ吗？在Q上发附件给你行吗？我Q是413061378

3abc

老师：还是写着“下标越界”，只计到36单位。你有QQ吗？在Q上发附件给你行吗？我Q是413061378

zhaogang1960

请检查工作表名是否规范，下面代码加了判断，请测试：
Sub Macro1()
    Dim myPath$, myFile$, wb As Workbook, m&, sh As Worksheet
    Set wb = ThisWorkbook
    myPath = ThisWorkbook.Path & "\分表\"
    myFile = Dir(myPath & "*.xls")
    Application.ScreenUpdating = False
    Do While myFile <> ""
         m = m + 1
         With GetObject(myPath & myFile)
            For Each sh In .Sheets
                If InStr(sh.Name, "中学数据表") > 0 Then
                    wb.Sheets("中学数据表").Cells(1, m + 3).Resize(77).Value = sh.Range("D1:D77").Value
                    wb.Sheets("中学数据表").Cells(2, m + 3) = m
                ElseIf InStr(sh.Name, "小学数据表") > 0 Then
                    wb.Sheets("小学数据表").Cells(1, m + 3).Resize(77).Value = sh.Range("D1:D77").Value
                    wb.Sheets("小学数据表").Cells(2, m + 3) = m
                End If
            Next
            .Close False
         End With
       myFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

3abc

老师,谢谢你,问题全部解决.

abdias520

收藏学习，看到这么多代码头大。