[已解决]求助，VBA多个工作薄，按条件汇总到一个工作薄中，谢谢。

新一

求助，VBA多个工作薄，按条件汇总到一个工作薄中，谢谢。如附件中的“汇总”工作薄。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-12-23 04:29

格式统一方便后期汇总，楼主的数据有点乱

跳转到最佳答案楼层

dsmch

有的工作薄一个工作表，有的三个工作表，按什么规律汇总工作表？

dsmch

1. Sub Macro1()
   
2. Dim mypath$$, wj$$, wb As Workbook, arr, i&, s&
   
3. Dim sht As Worksheet, brr(1 To 50000, 1 To 5)
   
4. Application.ScreenUpdating = False
   
5. mypath = ThisWorkbook.Path & ""
   
6. wj = Dir(mypath & "*.xls")
   
7. Do While wj <> ""
   
8.     If wj <> ThisWorkbook.Name Then
   
9.        With GetObject(mypath & wj)
   
10.             Set sht = .Sheets(.Sheets.Count)
    
11.             arr = sht.UsedRange
    
12.             bm = Mid(arr(3, 1), 6)
    
13.             mc = Mid(arr(4, 1), 6)
    
14.             n = IIf(sht.Cells(5, 1).MergeCells, 3, 2)
    
15.             For i = 6 To UBound(arr)
    
16.                 If arr(i, n + 3) <> "" And Not sht.Cells(i, n).MergeCells Then
    
17.                     s = s + 1
    
18.                     brr(s, 1) = bm
    
19.                     brr(s, 2) = mc
    
20.                     brr(s, 3) = arr(i, n + 9)
    
21.                     brr(s, 4) = arr(i, n)
    
22.                     brr(s, 5) = arr(i, n + 3)
    
23.                 End If
    
24.             Next
    
25.             .Close 0
    
26.         End With
    
27.     End If
    
28.     wj = Dir
    
29. Loop
    
30. [e:e].NumberFormatLocal = "@"
    
31. Range("a2").Resize(s, 5) = brr
    
32. Application.ScreenUpdating = True
    
33. End Sub

复制代码

dsmch

格式统一方便后期汇总，楼主的数据有点乱

新一

dsmch 发表于 2014-12-23 04:29
格式统一方便后期汇总，楼主的数据有点乱

谢谢老师，只要工作薄的第一个工作表就可以了，我忘记写上了，谢谢老师。{:011:}

alantsai777

THANK YOU FOR SHARE !