多工作簿数据汇总指定条件的数据

我是小黑屋

请教一下EH的朋友们，如何将指定文件夹中的所有工作簿(包括其中的子文件夹的工作簿)中的sheet1工作表中"C"列备注是"A店"的数据复制到本工作表中


Desktop.zip (47.4 KB, 下载次数: 23)

2017-3-6 18:49 上传

点击文件名下载附件

我是小黑屋

麻烦各位帮忙看看

kzg2013

解压后，有一个"宏表格",点击，即可

我是小黑屋

kzg2013 发表于 2017-3-6 21:15
解压后，有一个"宏表格",点击，即可

老师您好，不知道是否可以大概注释下代码的大概意思，想学习了解下

chxw68

1. Sub test()
   
2.   Dim r%, i%, n%
   
3.   Dim arr$(), brr(1 To 10000, 1 To 3)
   
4.   Dim wb As Workbook
   
5.   Dim ws As Worksheet
   
6.   Dim mypath$, myname$
   
7.   Dim fso As New Scripting.FileSystemObject
   
8.   mypath = ThisWorkbook.Path & "\新建文件夹"
   
9.   Set f = fso.GetFolder(mypath)
   
10.   Call GetFiles(f, arr, 0)
    
11.   For k = 1 To UBound(arr)
    
12.     Set wb = GetObject(arr(k))
    
13.     With wb
    
14.       With .Worksheets("sheet1")
    
15.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
16.         crr = .Range("a2:c" & r)
    
17.         For i = 1 To UBound(crr)
    
18.           If crr(i, 3) = "A店" Then
    
19.             n = n + 1
    
20.             brr(n, 1) = crr(i, 1)
    
21.             brr(n, 2) = crr(i, 2)
    
22.             brr(n, 3) = crr(i, 3)
    
23.           End If
    
24.         Next
    
25.       End With
    
26.       .Close False
    
27.     End With
    
28.   Next
    
29.   With Worksheets("sheet1")
    
30.     .UsedRange.Offset(1, 0).Clear
    
31.     .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
32.   End With
    
33. End Sub
    
34. Sub GetFiles(ByVal Folder As Object, arr$(), m&)
    
35.   Dim SubFolder As Object
    
36.   Dim File As Object
    
37.   For Each File In Folder.Files
    
38.     If File.Name Like "*.xls*" Then
    
39.       m = m + 1
    
40.       ReDim Preserve arr(1 To m)
    
41.       arr(m) = File
    
42.     End If
    
43.   Next
    
44.   For Each SubFolder In Folder.SubFolders
    
45.     Call GetFiles(SubFolder, arr, m)
    
46.   Next
    
47. End Sub
    

复制代码

chxw68

详见附件。

自己151

kzg2013 发表于 2017-3-6 21:15
解压后，有一个"宏表格",点击，即可

很厉害，但是，如果不知道级数怎么办？

kzg2013

自己151 发表于 2017-3-6 21:53
很厉害，但是，如果不知道级数怎么办？

如果级数多，可以用application.filesearch循环获取表格路径，然后再提取数据。

我是小黑屋

chxw68 发表于 2017-3-6 21:51

老师您好，我想将您代码中第14行这一句 With .Worksheets("sheet1")改为指定工作表名称，例如 With .Worksheets("测试")，但是会出错，加了“On Error Resume Next”进去，读取就会出现重复了。麻烦老师指定一二

自己151

kzg2013 发表于 2017-3-6 23:02
如果级数多，可以用application.filesearch循环获取表格路径，然后再提取数据。

filesearch 在2007版之后就不能使用了。