汇总文件夹下的工作表数据

绿色心情小天使

各位晚上好：
文件夹下有1、2、3三个工作表，需要汇总123三表的数据到汇总表上！
请查阅附件！！！
工作表汇总.rar (28.49 KB, 下载次数: 38)

2019-1-4 21:11 上传

点击文件名下载附件

LMY123

1. ub 同夹_多薄_多表_合并成一薄一表_数组法()
   
2.     Cells.Clear
   
3.     时间 = Timer
   
4.     Dim 结果数组(1 To 65536, 1 To 12)
   
5.     路径 = ThisWorkbook.Path & ""
   
6.     外薄 = Dir(路径 & "*.xls*")
   
7.     Application.ScreenUpdating = False
   
8.     Do While 外薄 <> ""
   
9.         If 外薄 <> ThisWorkbook.Name Then
   
10.             With Workbooks.Open(路径 & 外薄)
    
11.                 For Each 外表 In .Sheets
    
12.                     If Len(外表.[A1]) Then
    
13.                         外数组 = 外表.[A1].CurrentRegion
    
14.                         For i = 2 To UBound(外数组)
    
15.                             If Len(外数组(i, 1)) Then
    
16.                                 计数器 = 计数器 + 1
    
17.                                 For j = 1 To UBound(结果数组, 2)
    
18.                                     结果数组(计数器, j) = 外数组(i, j)
    
19.                                 Next
    
20.                             End If
    
21.                         Next
    
22.                     End If
    
23.                 Next
    
24.                 .Close False
    
25.             End With
    
26.         End If
    
27.         外薄 = Dir
    
28.     Loop
    
29.     [A2].Resize(计数器, 12) = 结果数组
    
30.     Application.ScreenUpdating = True
    
31.     MsgBox Timer - 时间
    
32. End Sub

复制代码

abc123281

不错 使用汉语来作变量  通俗 直观

lsc900707

1. Sub test()
   
2.     Dim brr(1 To 99999, 1 To 12)
   
3.     Application.ScreenUpdating = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
   
6.         If InStr(f.Name, "汇总") = 0 Then
   
7.             Set wb = Workbooks.Open(f)
   
8.             arr = wb.Sheets(1).[a1].CurrentRegion
   
9.             For i = 2 To UBound(arr)
   
10.                 m = m + 1
    
11.                 For j = 1 To 12
    
12.                     brr(m, j) = arr(i, j)
    
13.                 Next
    
14.             Next
    
15.             wb.Close False
    
16.         End If
    
17.     Next
    
18.     If m Then
    
19.         [a1].CurrentRegion.Offset(1).ClearContents
    
20.         [a2].Resize(m, 12) = brr
    
21.     End If
    
22.     Application.ScreenUpdating = True
    
23. End Sub

复制代码

lsc900707

参考测试附件：

minren118

没下载源文件看过，这种需求，最后抽象成工作薄合并的功能，用现成的插件方法来实现，各大插件都有提供工作薄合并功能，包括ExcelHome的易用宝。
Excel催化剂也提供这些功能

xinlan6

lsc900707 发表于 2019-1-5 10:05

请教老师：
如果需要在M、N列显示汇总数据原来所在的工作簿及工作表名称，该如何修改这个代码？
谢谢！

xinlan6

LMY123 发表于 2019-1-4 21:27

请教老师：
运行代码时提示：运行错误1004  应用程序定义或对象定义错误
[a2].Resize(计数器, 12) = 结果数组   显示黄色
是哪里出问题吗

LMY123

xinlan6 发表于 2019-1-5 20:05
请教老师：
运行代码时提示：运行错误1004  应用程序定义或对象定义错误
[a2].Resize(计数器, 12) = 结 ...

上传出错的附件吧。

xinlan6

LMY123 发表于 2019-1-5 20:08
上传出错的附件吧。

麻烦老师帮忙看看，谢谢