[已解决]请教老师，帮我实现VBA自动汇总功能！

lsy1133

如附件，有许多附表，如何把附表上相同信息汇总到一张表格中？谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-4-7 11:43

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 2), rng As Range
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To Sheets.Count
   
5.     If Sheets(i).Name <> "汇总" Then
   
6.         Set rng = Sheets(i).[a:a].Find("应收利息", lookat:=xlWhole)
   
7.         arr = rng.CurrentRegion
   
8.         For j = 3 To UBound(arr) - 1
   
9.             If arr(j, 1) <> "" Then
   
10.                 s = s + 1
    
11.                 brr(s, 1) = arr(j, 1)
    
12.                 brr(s, 2) = arr(j, 4)
    
13.                 n = n + arr(j, 4)
    
14.             End If
    
15.         Next
    
16.     End If
    
17. Next
    
18. brr(s + 1, 1) = "合计"
    
19. brr(s + 1, 2) = n
    
20. Range("f4").Resize(s + 1, 2) = brr
    
21. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 2), rng As Range
   
3. Set d = CreateObject("scripting.dictionary")
   
4. For i = 1 To Sheets.Count
   
5.     If Sheets(i).Name <> "汇总" Then
   
6.         Set rng = Sheets(i).[a:a].Find("应收利息", lookat:=xlWhole)
   
7.         arr = rng.CurrentRegion
   
8.         For j = 3 To UBound(arr) - 1
   
9.             If arr(j, 1) <> "" Then
   
10.                 s = s + 1
    
11.                 brr(s, 1) = arr(j, 1)
    
12.                 brr(s, 2) = arr(j, 4)
    
13.                 n = n + arr(j, 4)
    
14.             End If
    
15.         Next
    
16.     End If
    
17. Next
    
18. brr(s + 1, 1) = "合计"
    
19. brr(s + 1, 2) = n
    
20. Range("f4").Resize(s + 1, 2) = brr
    
21. End Sub

复制代码

lsy1133

dsmch 发表于 2015-4-7 11:43

怎么在老师手里就这么容易呢，我编了几天都没编好呢！太感谢了！