[已解决]如何将多个工作簿中的数据合并到一个工作表中

729923765

已知道怎么将多个工作簿中的数据合并到一个工作表中，但只想汇总几个工作簿中“发放形式”为“电汇”的，请教！！！

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-12-11 12:41

请测试：
多工作薄汇总3.rar (23.11 KB, 下载次数: 57)

2013-12-11 12:50 上传

点击文件名下载附件

跳转到最佳答案楼层

yyyydddd8888

请测试：
多工作薄汇总3.rar (23.11 KB, 下载次数: 57)

2013-12-11 12:50 上传

点击文件名下载附件

729923765

谢谢

yyyydddd8888

729923765 发表于 2013-12-11 12:46
谢谢

请用这一个，这个的区划简码为文本，不会成为科学计数法的数字。
多工作薄汇总3.rar (23.11 KB, 下载次数: 21)

2013-12-11 12:51 上传

点击文件名下载附件

tgydslr

1. Sub UnionWorksheets()
   
2. Application.ScreenUpdating = False
   
3. Dim lj As String
   
4. Dim dirname As String
   
5. Dim nm As String
   
6. Dim i As Integer, ii As Integer
   
7. lj = ActiveWorkbook.Path
   
8. nm = ActiveWorkbook.Name
   
9. dirname = Dir(lj & "\*.xls")
   
10. Cells.Clear
    
11. 
    
12. Do While dirname <> ""
    
13. If dirname <> nm Then
    
14. Workbooks.Open Filename:=lj & "" & dirname
    
15. ii = ActiveWorkbook.Sheets.Count
    
16. Workbooks(nm).Activate
    
17. '复制新打开工作簿的每一个工作表的已用区域到当前工作表
    
18. For i = 1 To ii
    
19. Workbooks(dirname).Sheets(i).UsedRange.Copy _
    
20. Range("a65536").End(xlUp).Offset(2, 0)
    
21. Next
    
22. Workbooks(dirname).Close False
    
23. End If
    
24. dirname = Dir
    
25. Loop
    
26. 
    
27. End Sub

复制代码

729923765

yyyydddd8888 发表于 2013-12-11 12:50
请用这一个，这个的区划简码为文本，不会成为科学计数法的数字。

这个表会了，但运用到实际表中又不会改了，求救！

729923765

汇总“数量”等于“1”的

yyyydddd8888

729923765 发表于 2013-12-11 13:44
汇总“数量”等于“1”的

请测试：

111.rar (101.05 KB, 下载次数: 20)

2013-12-11 15:11 上传

点击文件名下载附件

1. Sub 按钮1_Click()
   
2.    Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   
3.    Dim arr, brr(1 To 100000, 1 To 20), j&, k&, m&
   
4.    Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   
5.    myPath = ThisWorkbook.Path & "\分类台账"          '把文件路径定义给变量
   
6.    
   
7.    myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   
8.    Do While myFile <> ""                     '当指定路径中有文件时进行循环
   
9.       If myFile <> ThisWorkbook.Name Then
   
10.          Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
    
11.          
    
12.           For i = 1 To AK.Sheets.Count
    
13.           aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row
    
14.           arr = AK.Sheets(i).Range("a6:t" & aRow)
    
15.               For j = 1 To UBound(arr)
    
16.                  If arr(j, 10) = 1 Then
    
17.                     k = k + 1
    
18.                     For m = 1 To 20
    
19.                         brr(k, m) = arr(j, m)
    
20.                     Next m
    
21.                  End If
    
22.               Next j
    
23.    
    
24.          Next i
    
25.          Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
    
26.       End If
    
27.       myFile = Dir                                   '找寻下一个*.xls文件
    
28.    Loop
    
29.     ThisWorkbook.Sheets("在用资产汇总").Range("a6").Resize(k, 20) = brr
    
30.    Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
    
31.    MsgBox "汇总完成，请查看！", 64, "提示"
    
32. 
    
33. End Sub
    

复制代码