多表部分数据汇总到一个表中

随缘。。。。

各位老师好： 现在有多少由系统生成的表，我想要汇总提取部分数把，不知能不能实现，请帮忙解决一下，谢谢！

zhouxiao

用VBA代码循环合并工作簿就可以.
去VBA版块求助吧..

鄂龙蒙

1. Sub 取数()
   
2.     Sheet1.Range("a1").CurrentRegion.Offset(2).ClearContents
   
3.     Application.ScreenUpdating = False
   
4.     Dim wb As Workbook, Sht As Worksheet
   
5.     Dim arr(), i
   
6.     tim = Timer
   
7.     sa = Array(2, 3, 4, 8, 8)
   
8.     sb = Array(8, 11, 3, 12, 14)
   
9.     f = Dir(ThisWorkbook.Path & "\*.xls")
   
10.         Do While f <> ""
    
11.             If f <> ThisWorkbook.Name Then
    
12.                 Set wb = Workbooks.Open(ThisWorkbook.Path & "" & f)
    
13.                 n = n + 1
    
14.                 ReDim Preserve arr(1 To 5, 1 To n)
    
15.                 For i = 0 To 4
    
16.                     If i = 1 Then
    
17.                         arr(2, n) = Mid(wb.Sheets(1).Cells(sa(i), sb(i)), 4, 4)
    
18.                     Else
    
19.                         arr(i + 1, n) = wb.Sheets(1).Cells(sa(i), sb(i))
    
20.                     End If
    
21.                 Next
    
22.                 wb.Close False
    
23.             End If
    
24.             f = Dir
    
25.         Loop
    
26.     Sheet1.Range("A:A").NumberFormatLocal = "@"
    
27.     Sheet1.[A3].Resize(n, 5).Value = Application.Transpose(arr)
    
28.     MsgBox Format(Timer - tim, "共汇总了  " & n & "  个工作薄，耗时：0.00秒"), 64, "温馨提示"
    
29.     Application.ScreenUpdating = True
    
30. End Sub

复制代码

随缘。。。。

鄂龙蒙 发表于 2018-2-7 12:12

已贴到表中怎么不好使呢

c3a139

运行时提示Sheet1.[A3].Resize(n, 5).Value = Application.Transpose(arr)有问题