[已解决]合并多表数据

tayisha

有没有办法把2、3、4、5表合并成1表，附表 请教.rar (19.44 KB, 下载次数: 50)

2011-4-13 21:54 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-4-21 14:09

回复 tayisha 的帖子

附件： 多表汇总.rar (28.23 KB, 下载次数: 44)

2011-4-21 14:08 上传

点击文件名下载附件
注意：你的分表要放进里面的分表文件夹里
试试看

1. Sub huizong()
   
2.    Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
3.    Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
4.    myPath = ThisWorkbook.Path & "\分表"          '把文件路径定义给变量
   
5.    
   
6.    myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   
7.    Do While myFile <> ""                     '当指定路径中有文件时进行循环
   
8.       If myFile <> ThisWorkbook.Name Then
   
9.          Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
   
10.           For i = 1 To AK.Sheets.Count
    
11.          aRow = AK.Sheets(i).Range("b65536").End(xlUp).Row
    
12.          tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1
    
13.             'AK.Sheets(i).Select
    
14.          AK.Sheets(i).Range("a2:o" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
    
15.          Next
    
16.          Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
    
17.       End If
    
18.       myFile = Dir                                   '找寻下一个*.xls文件
    
19.    Loop
    
20.       
    
21.    Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
22.    MsgBox "汇总完成，请查看！再次执行汇总会重复统计", 64, "提示"
    
23. 
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

xiaoni

这问题如果在一个工作薄中用导入外部数据——编辑查询用union all来连接好弄，关键是不是一个工作薄中就不好弄了

tayisha

编辑查询用union all 不是很理解

tayisha

拜就解

飞天小猪

要打开所有表的话，太麻烦了

tayisha

那要怎么解呢，还是不明了

sunjing-zxl

回复 tayisha 的帖子

附件： 多表汇总.rar (28.23 KB, 下载次数: 44)

2011-4-21 14:08 上传

点击文件名下载附件
注意：你的分表要放进里面的分表文件夹里
试试看

1. Sub huizong()
   
2.    Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
3.    Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
4.    myPath = ThisWorkbook.Path & "\分表"          '把文件路径定义给变量
   
5.    
   
6.    myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   
7.    Do While myFile <> ""                     '当指定路径中有文件时进行循环
   
8.       If myFile <> ThisWorkbook.Name Then
   
9.          Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
   
10.           For i = 1 To AK.Sheets.Count
    
11.          aRow = AK.Sheets(i).Range("b65536").End(xlUp).Row
    
12.          tRow = ThisWorkbook.Sheets(1).Range("b65536").End(xlUp).Row + 1
    
13.             'AK.Sheets(i).Select
    
14.          AK.Sheets(i).Range("a2:o" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
    
15.          Next
    
16.          Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
    
17.       End If
    
18.       myFile = Dir                                   '找寻下一个*.xls文件
    
19.    Loop
    
20.       
    
21.    Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
22.    MsgBox "汇总完成，请查看！再次执行汇总会重复统计", 64, "提示"
    
23. 
    
24. End Sub
    

复制代码

tayisha

哇噻，太厉害了

tayisha

就是执行一次，有三次汇总哦

sunjing-zxl

回复 tayisha 的帖子

你把要汇总的表格全部放进分表文件夹。。

就一起汇总完了。。。

不明白你的三次是什么意思？？