超难的多工作簿多工作表汇总信息

wave0403

汇总同一文件夹下多个相同格式（每个工作簿有两个不同格式的纵向表），每个工作簿有两个不同格式的纵向表不太好做，求高手相助！最终生成“汇总.xls”

wave0403

在线等，恳请有过类似用法的高手不吝赐教！

lq93808-2

对于那些高手来说,也不算是难,我也观望.

lq93808-2

做好了,看看,吧.

wave0403

感谢lq93808-2的相助！不知可否告知工程密码，我再举一反三。

opiona

1. '*********************************
   
2. '*******  北极狐工作室出品  ******
   
3. '*******  QQ：14885553      ******
   
4. '*********************************
   
5. 
   
6. Sub Opiona()
   
7. 
   
8. '禁止系统刷屏?触发其他事件等
   
9. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
10. Application.ScreenUpdating = False '//关闭屏幕刷新
    
11. Application.DisplayAlerts = False '//关闭系统提示
    
12. Application.EnableEvents = False  '//禁止触发其他事件
    
13. t = Timer   '//开始时间
    
14. 
    
15.     Set SH0 = Sheets("汇总")
    
16.     SH0.Range("A2:Z65536").ClearContents
    
17.     FileArr = FileAllArr(ThisWorkbook.Path & "", "*.xls?", ThisWorkbook.Name, False)
    
18.     For I = 0 To UBound(FileArr)
    
19.    
    
20.         Set WB = Workbooks.Open(FileArr(I))   '//打开工作簿
    
21.         Set NSH1 = WB.Sheets("正面")
    
22.         Set NSH2 = WB.Sheets("反面")
    
23.         SH0.Cells(I + 2, 1) = NSH1.Cells(2, 3)
    
24.         SH0.Cells(I + 2, 2) = NSH1.Cells(2, 7)
    
25.         SH0.Cells(I + 2, 3) = NSH1.Cells(2, 17)
    
26.         SH0.Cells(I + 2, 4) = NSH1.Cells(4, 3)
    
27.         SH0.Cells(I + 2, 5) = NSH1.Cells(4, 7)
    
28.         SH0.Cells(I + 2, 6) = NSH1.Cells(4, 17)
    
29.         SH0.Cells(I + 2, 7) = NSH1.Cells(5, 3)
    
30.         SH0.Cells(I + 2, 8) = NSH1.Cells(5, 7)
    
31.         SH0.Cells(I + 2, 9) = NSH1.Cells(5, 17)
    
32.         SH0.Cells(I + 2, 10) = NSH1.Cells(6, 3)
    
33.         SH0.Cells(I + 2, 11) = NSH1.Cells(6, 12)
    
34.         SH0.Cells(I + 2, 12) = NSH2.Cells(2, 4)
    
35.         SH0.Cells(I + 2, 13) = NSH2.Cells(3, 4)
    
36.         SH0.Cells(I + 2, 13) = NSH2.Cells(5, 4)
    
37.         WB.Close False
    
38.     Next
    
39. 
    
40. Application.EnableEvents = True  '//  '//恢复触发其他事件
    
41. Application.ScreenUpdating = True '//恢复屏幕刷新
    
42. Application.DisplayAlerts = True '//恢复系统提示
    
43. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
44. 
    
45. End Sub

复制代码

opiona

完整代码见附件： 2002.rar (23.1 KB, 下载次数: 158)

2015-7-28 20:25 上传

点击文件名下载附件

wave0403

太感谢大家的帮助！