电气安装工程量计算表VBA求助

bbsy83

小弟是做安装预算的，VBA这块也是不会，自己编了一个表格，计算表格是可以自动计算的，但汇总这块不知道怎么做到另一张表上面去，现在附件是我自己手动汇总的，请哪位大神能帮我用VBA实现这个安装表格工程量自动计算和分类汇总的功能，小弟不胜感激！

mythqiu

我写了格通用的

任意设置计算式的各项目在任意列：工程量、倍数、计算式、单位、代号，
任意设置汇总的关键列（设计表格时需要放在一起，比如说以 B,C,D,E列数据作为汇总）你设定的列 程序会自动+单位一列作为共同的汇总条件。

mythqiu

自动计算

任意多个关键项目自动汇总。
参见：https://club.excelhome.net/thread-1613687-1-1.html
可以任意移植的计算式程序

liulang0808

可以考虑使用字典进行汇总。。。。
论坛资料可以查查

bbsy83

谢谢提醒！

bbsy83

有那位大神可以帮忙写下电气安装表格工程量自动计算和分类汇总的功能，小弟不胜感激！

microyip

3楼的方法是OK的，搜索一下相关帖，抄改一下代码即可

bbsy83

microyip 发表于 2019-8-13 08:07
3楼的方法是OK的，搜索一下相关帖，抄改一下代码即可

老哥，关键VBA我是门外汉，代码都看不懂。。。

ggmmlol

做工程的，厉害！基建狂魔，有你一份功劳，支持一下:

1. Sub test()
   
2. Sheet2.UsedRange.Offset(1).Clear
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet1
   
5.     r = .Cells(Rows.Count, "K").End(xlUp).Row
   
6.     ar = .Range("K1:Q" & r)
   
7.     ReDim br(1 To r, 1 To 3): n = 0
   
8.     For i = 6 To r
   
9.         s = ar(i, 1) & "|" & ar(i, 2)
   
10.         If Len(s) - 1 Then
    
11.             If d.exists(s) Then
    
12.                 p = d(s)
    
13.                 br(p, 3) = br(p, 3) + ar(i, 7)
    
14.             Else
    
15.                 n = n + 1
    
16.                 d(s) = n
    
17.                 br(n, 1) = ar(i, 1)
    
18.                 br(n, 2) = ar(i, 2)
    
19.                 br(n, 3) = ar(i, 7)
    
20.             End If
    
21.         End If
    
22.     Next
    
23.     Sheet2.Range("A2").Resize(n, 3) = br
    
24. '-----------------
    
25.     r = .Cells(Rows.Count, "S").End(xlUp).Row
    
26.     ar = .Range("S1:Y" & r)
    
27.     ReDim br(1 To r, 1 To 3): n = 0: d.RemoveAll
    
28.     For i = 6 To r
    
29.         s = ar(i, 1) & "|" & ar(i, 2)
    
30.         If Len(s) - 1 Then
    
31.             If d.exists(s) Then
    
32.                 p = d(s)
    
33.                 br(p, 3) = br(p, 3) + ar(i, 7)
    
34.             Else
    
35.                 n = n + 1
    
36.                 d(ar(i, 1) & "|" & ar(i, 2)) = n
    
37.                 br(n, 1) = ar(i, 1)
    
38.                 br(n, 2) = ar(i, 2)
    
39.                 br(n, 3) = ar(i, 7)
    
40.             End If
    
41.         End If
    
42.     Next
    
43.     Sheet2.Range("D2").Resize(n, 3) = br
    
44.     Sheet2.Range("a1").CurrentRegion.Borders.LineStyle = 1
    
45. End With
    
46. End Sub

复制代码

bbsy83

我用类似的代码帖进去，定义不对，不知道怎么修改了

bbsy83

我用类似的代码帖进去，定义不对，不知道怎么修改了