合并同一文件夹下的多个工作簿中的第一张表

shdh

同一文件夹下有多个工作簿，文件结构都是一样的，其中第一张表是公式提取的表二中的数据，现在想把表一格式的数据汇总，但用以前的合并工作簿的VBA汇总总是出错，可能是第二张表格式的问题，但对VBA不是很懂，请帮忙修改一下，谢谢。


11.7z (1.26 MB, 下载次数: 48)

2019-6-27 06:50 上传

点击文件名下载附件

liuxi001

1. 
   
2. Sub Macro2()
   
3.     Dim fd As FileDialog, wb As Workbook, sh As Worksheet, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     For Each sh In Sheets
   
8.         If sh.Name <> ActiveSheet.Name Then sh.Delete
   
9.     Next
   
10.     Set wb = ThisWorkbook
    
11.     Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
12.     fd.InitialFileName = ThisWorkbook.Path & ""
    
13.     With fd
    
14.         .Title = "请选择要合并的xls文件"
    
15.          If .Show = True Then
    
16.              For Each vrtselecteditem In .SelectedItems
    
17.              If InStr(vrtselecteditem, Left(wb.Name, InStrRev(wb.Name, ".") - 1)) = 0 Then
    
18.                 With Workbooks.Open(vrtselecteditem)
    
19.                   tmp=  .Sheets("学生学籍信息表").[a3:bz3].value
    
20. wb.Activesheet.[a65536].End(xlUp).Offset(1).resize(1,ubound(tmp,2))=tmp
    
21. erase tmp
    
22.                     .Close False
    
23.                 End With
    
24.             End If
    
25.              Next
    
26.          End If
    
27.     End With
    
28.     Sheets(1).Activate
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "ok"
    
31. End Sub
    

复制代码

shdh

liuxi001 发表于 2019-6-27 10:09

不好意思，我用这段代码替换后，还是不能正常显示。第一次运行的时候出现：

继续运行后，结果还是只有一张表格的内容：

这里能不能只提取合并“学籍信息表”的内容，忽略其他表格内容？
另外第一步的问题是版本的问题还是什么原因啊？我的版本是最新版1906 64位

liuxi001

wb.Activesheet.[a65536].End(xlUp).Offset(1)

上句不知为何掉了sheet
我猜也是只要第一个表的内容

shdh

liuxi001 发表于 2019-6-27 13:55
wb.Activesheet.[a65536].End(xlUp).Offset(1)

上句不知为何掉了sheet

麻烦你再看下,合并没有问题，但合并后的格式发生了错乱。

这个咋整呢？

LZH02620

需要把包含宏的表命名为“汇总表.xlsm”，第一个工作表命名为“汇总表”，其他需要汇总的表放在同一个文件夹下。
Sub 多档合并()
    Dim arr
    Dim n_row As Long, j As Long
    Dim fn, filename, folder As String
    Dim wk, wb, sht As Object
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set wk = ThisWorkbook.Worksheets("汇总表")  '数据汇总于此表
    Sheets("汇总表").Activate
    Sheets("汇总表").AutoFilterMode = False
    wk.Range("2:60000").ClearContents
    folder = ThisWorkbook.Path
    filename = Dir(folder & "\*.xls?")
    n_row = 3
    Do While filename <> ""
        If filename = "汇总表.xlsm" Then GoTo line0
        fn = folder & "\" & filename
        Set wb = GetObject(fn)
        Set sht = wb.Worksheets("学生学籍信息表")
        sht.AutoFilterMode = False
        j = sht.Range("C65536").End(xlUp).Row
        arr = sht.Range("a3:j" & j)
        wb.Close False
        n_row = wk.Range("C65536").End(xlUp).Row
        wk.Range("a" & n_row + 1).Resize(j - 1, 10) = arr
line0:  filename = Dir
    Loop
    Set wk = Nothing
    Set wb = Nothing
    Set sht = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

liuxi001

shdh 发表于 2019-6-27 14:56
麻烦你再看下,合并没有问题，但合并后的格式发生了错乱。

这个咋整呢？

你的表里有公式造成的，自己想办法处理下吧。。。花花都没有，没有动力

shdh

liuxi001 发表于 2019-6-27 18:44
你的表里有公式造成的，自己想办法处理下吧。。。花花都没有，没有动力

感谢了，花儿奉上，昨天太忙了

shdh

LZH02620 发表于 2019-6-27 15:22
需要把包含宏的表命名为“汇总表.xlsm”，第一个工作表命名为“汇总表”，其他需要汇总的表放在同一个文件 ...

感谢，不过我用了这个代码后，并没有把第一张表中的数据完全合并，只合并到J项就完了啊

xiangbaoan

………………