求教一个汇总表格用的宏

ykqrs

还是很慢，不会改啦

1. Sub ww()
   
2. Cells.Clear
   
3. Dim mapath$, maname$, wb As Workbook, ws As Worksheet, s$, r%
   
4. Dim t, arr, brr(), n%, i%, j%, x%
   
5. t = Timer
   
6. Application.ScreenUpdating = False
   
7. Application.DisplayAlerts = False
   
8. mapath = ThisWorkbook.Path & ""
   
9. maname = Dir(mapath & "*初审*.xlsx")
   
10. Do While maname <> ""
    
11. If maname <> ThisWorkbook.Name Then
    
12. 'r = r + 2
    
13. Set wb = Workbooks.Open(mapath & maname)
    
14. For Each ws In wb.Sheets
    
15. If ws.Name = "成本单（表3）" Then
    
16. arr = ws.[a1].CurrentRegion '.Copy ThisWorkbook.Sheets("sheet1").Range("a" & r)
    
17. For i = 1 To UBound(arr)
    
18. n = n + 1
    
19. ReDim Preserve brr(1 To 31, 1 To n)
    
20. For j = 1 To 31
    
21. brr(j, n) = arr(i, j)
    
22. Next
    
23. Next
    
24. Exit For
    
25. End If
    
26. Next
    
27. End If
    
28. wb.Close
    
29. maname = Dir
    
30. 'r = Cells(Rows.Count, 1).End(xlUp).Row
    
31. Loop
    
32. [a1].Resize(n, 31) = Application.Transpose(brr)
    
33. MsgBox "程序用时" & Format(Timer - t, "0.00") & "秒"
    
34. End Sub
    

复制代码

ykqrs

新建文件夹.rar (1.56 MB, 下载次数: 31)

2016-11-29 11:50 上传

点击文件名下载附件