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

feiren228

1. Sub test()   'by feiren228
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim arr, brr, crr(1 To 100000, 1 To 14), n&, p$, nm$
   
5.     p = ThisWorkbook.Path & ""
   
6.     nm = Dir(p & "*.xls")
   
7.     Do While nm <> ""
   
8.         If nm <> ThisWorkbook.Name Then
   
9.             With GetObject(p & nm)
   
10.                 n = n + 1
    
11.                 arr = .Sheets("正面").Range("A1:V6")
    
12.                 brr = .Sheets("反面").Range("A1:D5")
    
13.                 .Close 0
    
14.                 crr(n, 1) = arr(2, 3): crr(n, 2) = arr(2, 7): crr(n, 3) = arr(2, 17)
    
15.                 crr(n, 4) = arr(4, 3): crr(n, 5) = arr(4, 7): crr(n, 6) = arr(4, 17)
    
16.                 crr(n, 7) = arr(5, 3): crr(n, 8) = arr(5, 7): crr(n, 9) = arr(5, 17)
    
17.                 crr(n, 10) = arr(6, 3): crr(n, 11) = arr(6, 12)
    
18.                 crr(n, 12) = brr(2, 4): crr(n, 13) = brr(3, 4): crr(n, 14) = brr(4, 4)
    
19.             End With
    
20.         End If
    
21.         nm = Dir
    
22.     Loop
    
23.     With Sheets("汇总")
    
24.         .[a2].Resize(6000, 14).ClearContents
    
25.         .[a2].Resize(n, 14) = crr
    
26.         .UsedRange.EntireRow.AutoFit
    
27.         .UsedRange.EntireColumn.AutoFit
    
28.     End With
    
29.     Application.DisplayAlerts = True
    
30.     Application.ScreenUpdating = True
    
31. End Sub
    

复制代码

百度不到去谷歌

总是危言耸听的题目才能吸引人啊

海军中士2013

高手呀，膜拜，太厉害了，thank  you  for  your share！

dqld

设置合适的数据收集表格很重要，省工省时省力，便于汇总、分析。

EXCEL-MMSD

牛！！！！！！！！！！！！！！！

jjmysjg

11楼第25行代码，为什么不能运行。
麻烦各位老师看看
谢谢

康康天下

opiona 发表于 2015-7-28 20:24

这个非常明了！！如果出现要计算统计的话，该怎么修改呢？？谢谢

opiona

康康天下 发表于 2018-8-7 21:57
这个非常明了！！如果出现要计算统计的话，该怎么修改呢？？谢谢

http://club.excelhome.net/thread-1409141-1-1.html

康康天下

opiona 发表于 2018-8-8 08:29
http://club.excelhome.net/thread-1409141-1-1.html

谢谢！不过我想要的是按关键字进行汇总统计计算的那种，请问有吗？？谢谢

ykcbf1100

我承认，我是被标题吸引进来的