汇总同文件夹下多个工作簿数据问题

alidetu

Sub HzWb()
    Dim bt As Range, r As Long, c As Long
    r = 1    '1 是表头的行数
    c = 8    '8 是表头的列数
    Range(Cells(r + 1, "A"), Cells(65536, c)).ClearContents    ' 清除汇总表中原表数据
    Application.ScreenUpdating = False
    Dim FileName As String, wb As Workbook, Erow As Long, fn As String, arr As Variant
    FileName = Dir(ThisWorkbook.Path & "\*.xls")
    Do While FileName <> ""
        If FileName <> ThisWorkbook.Name Then    ' 判断文件是否是本工作簿
            Erow = Range("A1").CurrentRegion.Rows.Count + 1    ' 取得汇总表中第一条空行行号
            fn = ThisWorkbook.Path & "\" & FileName
            Set wb = GetObject(fn)    ' 将fn 代表的工作簿对象赋给变量
            Set sht = wb.Worksheets(1)    ' 汇总的是第1 张工作表
            ' 将数据表中的记录保存在arr 数组里
            arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))
            ' 将数组arr 中的数据写入工作表
            Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
            wb.Close False
        End If
        FileName = Dir    ' 用Dir 函数取得其他文件名，并赋给变量
    Loop
    Application.ScreenUpdating = True
End Sub


程序中标黄色的怎么理解，就是书中4.7.10的例子，求大神解释

zjdh

arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))
将工作表（左上角）A1至（右下角）B列最末尾非空格单元区域，向右偏离8列的内容赋值给数组arr

Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
当前工作表（汇总表）A列末尾空单元起，与arr相同单元数行和相同列数范围，填入数组arr数值。

alidetu

zjdh 发表于 2017-1-7 12:47
arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))
将工作表（左上角） ...

arr = sht.Range(sht.Cells(r, "A"), sht.Cells(65536, "B").End(xlUp).Offset(0, 8))这句话形成的arr是几维数组，怎么判断

Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
是从A1单元格扩展区域，新区域的行数是arr中第一个数组的最大索引号，列号是第二个数组的最大索引号，为什么可以这样


再问程序中对sht都没有定义都可以直接这样使用吗Set sht = wb.Worksheets(1)    ' 汇总的是第1 张工作表

zjdh

1. 是几维数组，你打开看看就不都明白啦。
2. 我不懂哪个是第二个数组
3. 当然可以。

alidetu

zjdh 发表于 2017-1-9 21:48
1. 是几维数组，你打开看看就不都明白啦。
2. 我不懂哪个是第二个数组
3. 当然可以。

请问怎样看是是几维数组

zjdh

这是2维的


这是3维的

alidetu

zjdh 发表于 2017-1-10 13:17
这是2维的

请问论坛里怎么传图片呢

zjdh

和传附件一样操作。点击“回形针”，选择文件上传