工作表结构相同的多工作薄能合并成一个工作薄文件吗

guihuawc

chxw68 发表于 2017-3-3 11:07
你认真测试了吗？这段代码就是将文件夹内所有工作簿内的工作内容汇总到一张表呀！

我在文件夹下增加了相同结构的工作薄　但不能将其中的内容汇总到汇总工作表里　确认　谢谢老师

chxw68

不会有这样的问题！我在文件夹里复制了好几个文件，你打开\需要合并的工作簿\汇总表.xls，点击里面的按钮试试。

guihuawc

chxw68 发表于 2017-3-3 11:51
不会有这样的问题！我在文件夹里复制了好几个文件，你打开\需要合并的工作簿\汇总表.xls，点击里面的按钮试 ...

需要合并的工作薄(测试).zip (328.34 KB, 下载次数: 12)

2017-3-3 12:56 上传

点击文件名下载附件

老师麻烦您再看一下　我测试了依然不行　现在我更新了文件夹下工作薄　您更容易理解　汇总时汇兑的数据不正常

chxw68

我醉了！你不是在1楼中说的“每个文件里只有一个学生的信息”吗？

guihuawc

确实是我没说清楚  没想到这个误导了老师 谢谢

lsc900707

guihuawc 发表于 2017-3-3 12:57
老师麻烦您再看一下　我测试了依然不行　现在我更新了文件夹下工作薄　您更容易理解　汇总时汇兑的数据 ...

Sub lsc()
Dim myPath$, MyName$, sh As Worksheet, t#
Dim Arr, brr, i&, j&, m&, n&
t = Timer
myPath = ThisWorkbook.Path & "\"
MyName = Dir(myPath & "*.xls*")
Application.ScreenUpdating = False
ReDim brr(1 To 100000, 1 To 8)
Do While MyName <> ""
    If MyName <> ThisWorkbook.Name Then
        n = n + 1
       Set sh = GetObject(myPath & MyName).Sheets("Sheet1")
              Arr = sh.[A1].CurrentRegion
              Workbooks(MyName).Close False
              For i = 4 To UBound(Arr)
                   m = m + 1
                   For j = 1 To 8
                        brr(m, j) = Arr(i, j)
                    Next
              Next
      End If
      MyName = Dir
Loop
Set sh = Nothing
With Sheet1
     .Rows("4:10000").ClearContents
     .[a4].Resize(m, UBound(brr, 2)).Value = brr
End With
Application.ScreenUpdating = True
MsgBox "汇总完成！汇总了：" & n & "个工作表；共有：" & m & "行数据。" & vbCr & "用时：" & Format(Timer - t, "0.00") & "秒", vbInformation
End Sub

guihuawc

lsc900707 发表于 2017-3-3 18:01
Sub lsc()
Dim myPath$, MyName$, sh As Worksheet, t#
Dim Arr, brr, i&, j&, m&, n&

太感谢了　这个帮我解决了问题　当然也感谢所有帮助我的老师！