求助VBA合并计算一个工作簿中指定工作表

weihaijun236

我想合并计算第4个表到第32个表的数据，怎么能自动获取数据源第4个表到第32个表，以后可以增加或减少，
Sub 宏2()
'
' 宏2 宏
'

'
    Selection.Consolidate sources:=Array("办公室!R2C2:R400C15", "邯郸玉兰苑办公室!R2C2:R400C15", _
        "邯郸美的广场!R2C2:R400C15", "邯郸翡翠蓝山办公室!R2C2:R400C15", "天津美的薛军顺!R2C2:R400C15", _
        "邯郸凤麟府!R2C2:R400C15", "石家庄陈瑞民!R2C2:R400C15", "黄渠办公室!R2C2:R400C15", _
        "黄渠临水临电!R2C2:R400C15", "音乐园王文革组!R2C2:R400C15", "东坝七颗树临水临电!R2C2:R400C15", _
        "半壁店陈志国!R2C2:R400C15", "半壁店任国明!R2C2:R400C15", "石家庄陈永刚!R2C2:R400C15", _
        "咸阳李现堂!R2C2:R400C15", "咸阳陈志国!R2C2:R400C15", "音乐园陈志国!R2C2:R400C15", _
        "王林家刘希宾!R2C2:R400C15", "马驹桥工地!R2C2:R400C15", "双桥工地!R2C2:R400C15", _
        "音乐园东院水!R2C2:R400C15", "万子营及大鲁店水电!R2C2:R400C15", "音乐园东院电!R2C2:R400C15", _
        "黄渠!R2C2:R400C15", "任文平!R2C2:R400C15", "苏州!R2C2:R400C15", _
        "土建转水电!R2C2:R400C15", "小汤山工地!R2C2:R400C15", _
        "七棵树李现堂!R2C2:R400C15"), Function:=xlSum _
        , toprow:=True, leftcolumn:=True, CreateLinks:=False
End Sub

这是合并计算原始，

蓝桥玄霜

汇总的例子：

沈默00

如果经常用这一类的表，可以把工作表名称设置成比如"A类"+原工作表名，以后再统计这类表，可以用INSTR从诸多的表里自动查找“A类*”

weihaijun236

分月汇总是合并后的效果

ykcbf1100

没实话，我没看明白，表太多，不知道楼主想怎么做。

weihaijun236

ykcbf1100 发表于 2023-12-31 20:42
没实话，我没看明白，表太多，不知道楼主想怎么做。

想在分月汇总得到我想合并计算第4个表到第32个表的数据，怎么能自动获取数据源第4个表到第32个表，现在已经正确合并了，就是需要把4到32个表的名称全部写上，怎么能自动获取4到32的表合并计算

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.1
   
2.     Dim arr, brr, d, d1
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     bm = Array("办公室", "邯郸玉兰苑办公室", _
   
8.         "邯郸美的广场", "邯郸翡翠蓝山办公室", "天津美的薛军顺", "邯郸凤麟府", "石家庄陈瑞民", "黄渠办公室", _
   
9.         "黄渠临水临电", "音乐园王文革组", "东坝七颗树临水临电", "半壁店陈志国", "半壁店任国明", "石家庄陈永刚", _
   
10.         "咸阳李现堂", "咸阳陈志国", "音乐园陈志国", "王林家刘希宾", "马驹桥工地", "双桥工地", _
    
11.         "音乐园东院水", "万子营及大鲁店水电", "音乐园东院电", _
    
12.         "黄渠", "任文平", "苏州", "土建转水电", "小汤山工地", "七棵树李现堂")
    
13.     For Each sht In Sheets(bm)
    
14.         With sht
    
15.             arr = .UsedRange
    
16.             For i = 4 To UBound(arr)
    
17.                 For j = 3 To 14
    
18.                     If arr(i, 2) <> Empty Then
    
19.                         s = arr(i, 2)
    
20.                         ss = arr(i, 2) & "|" & arr(2, j)
    
21.                         d1(s) = ""
    
22.                         
    
23.                         d(ss) = d(ss) + Val(arr(i, j))
    
24.                     End If
    
25.                 Next
    
26.             Next
    
27.         End With
    
28.     Next
    
29.     ReDim zrr(1 To d.Count, 1 To 2)
    
30.     For Each k In d1.keys
    
31.         m = m + 1
    
32.         zrr(m, 1) = m
    
33.         zrr(m, 2) = k
    
34.     Next
    
35.     With Sheets("分月汇总")
    
36.         .[a3].Resize(10000, 15) = ""
    
37.         .[a3].Resize(m, 2) = zrr
    
38.         arr = .[a1].Resize(m + 2, 15)
    
39.         For i = 3 To UBound(arr)
    
40.             Sum = 0
    
41.             For j = 3 To 14
    
42.                 s = arr(i, 2) & "|" & arr(2, j)
    
43.                 arr(i, j) = d(s)
    
44.                 Sum = Sum + arr(i, j)
    
45.             Next
    
46.             arr(i, 15) = Sum
    
47.         Next
    
48.         .[a1].Resize(m + 2, 15) = arr
    
49.     End With
    
50.     Set d = Nothing
    
51.     Set d1 = Nothing
    
52.     Application.ScreenUpdating = True
    
53.     MsgBox "OK！"
    
54. End Sub
    
55. 
    

复制代码

ykcbf1100

weihaijun236 发表于 2024-1-1 08:53
想在分月汇总得到我想合并计算第4个表到第32个表的数据，怎么能自动获取数据源第4个表到第32个表，现在已 ...

附件供参考。。。

weihaijun236

ykcbf1100 发表于 2024-1-1 10:46
附件供参考。。。

谢谢，能达到想要的效果