上一章给大家分享了一下关于VBA中的同一个工作薄中的多张工作表的内容汇总到该工作薄的工作表中,今天继续给大家分享一下关于同一文件夹下的多个工作薄的信息汇总到另外的工作薄中的同一个工作表下。
下面会使用UBound() 是获取数组最大索引数,有两个参数,第一个是数组名,第二个是数组的维。
下面就是今天需要使用到的数据表格:
就是要把学生表一中的二张表格和学生表二中的一张表格汇总到book中的sheet41中
还有下面一个表
下面是运行结果:
下面就是代码:
Sub ff()
Dim w As Workbook, s As Worksheet, f As String, h As Integer, f1 As String
Dim r As Range, i As Worksheet, j As Integer, i1 As Integer
Dim arr As Variant
Dim arr1(1 To 7) As Variant
Worksheets(“sheet41”).Range(“A1:G65536”).Rows.Clear
Application.ScreenUpdating = False
f = Dir(ThisWorkbook.Path & “\*.xlsx”)
Do While f <> “”
If f <> ThisWorkbook.Name Then
f1 = ThisWorkbook.Path & “\” & f
Set w = GetObject(f1)
For Each i In w.Worksheets
Set s = i
For i1 = 1 To 7
arr1(i1) = s.Cells(1, i1).Value
Next
For j = 1 To 7
Worksheets(“sheet41”).Cells(1, j).Value = arr1(j)
Worksheets(“sheet41”).Cells(1, j).Interior.Color = RGB(255, 0, 0)
With Worksheets(“sheet41”).Cells(1, j).Font
.Name = “宋体”
.Size = 14
.Bold = True
End With
Next
arr = s.Range(s.Cells(2, “A”), s.Cells(65536, “B”).End(xlUp).Offset(0, 8))
Set r = Worksheets(“sheet41”).Range(“A65536”).End(xlUp).Offset(1, 0)
Worksheets(“sheet41”).Range(r.Address).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
Next
w.Close
End If
f = Dir
Loop
Application.ScreenUpdating = True
End Sub
下面对代码解释一下:
注意:arr = s.Range(s.Cells(2, “A”), s.Cells(65536, “B”).End(xlUp).Offset(0, 8))
这里面表示的是A2到我表中G列最下一行的整个区域。
最后我再说一下,我上面为什么用i定义工作表不直接使用s,一步到位不太好看出从工作簿中取工作表,所以我就没有省去。如果感觉多余可以想下面一样,一步到位。其中上面取表头也是可以省略的,主要是想让大家多看一些代码,才添加的。