求教各位老师：怎么用VBA分大小项目动态汇总

GUANGGE

各位老师好：请教一下，怎么用VBA程序动态汇总上传图上的大小项目合计？谢谢。

GUANGGE

朱荣兴 发表于 2018-8-19 11:31
上传像样点的附件来看看，你的 B列  行数为变量，实际是什么？？？？

附件已经上传了。
大项目A项到B项之间现在的行数为2行，有可能随小项目的增加，行数增加到10行，也有可能减少到1行。
继续求教。谢谢。

GUANGGE

老师好：
再次上传附件。
谢谢。

xiangbaoan

……详见附件，仅供参考……

GUANGGE

xiangbaoan 发表于 2018-8-21 07:37
……详见附件，仅供参考……

老师您好：
谢谢，老师的答疑。
这表格是全智能化，比我想象的功能多得多了，太高级了。
老师，再求助一下，每行程序后能不能加说明，每行程序的作用？
谢谢！

xiangbaoan

GUANGGE 发表于 2018-8-21 10:01
老师您好：
谢谢，老师的答疑。
这表格是全智能化，比我想象的功能多得多了，太高级了。

好吧，有空时我写了回复你，不过你先了解一下数组、字典这些方面，本论坛知识树中有。
佛山小老鼠、香川群子等老师的都很经典，我也是认真拜读老师的大作才勉强入门的。
祝你进步！

GUANGGE

xiangbaoan 发表于 2018-8-21 10:29
好吧，有空时我写了回复你，不过你先了解一下数组、字典这些方面，本论坛知识树中有。
佛山小老鼠、香川 ...

谢谢，老师.
我正在努力学习VBA。
我先要学习数组，字典。
请您有空，加个程序说明。
谢谢。

xiangbaoan

GUANGGE 发表于 2018-8-21 11:04
谢谢，老师.
我正在努力学习VBA。
我先要学习数组，字典。

Sub test()
Dim ar, r&, i%, st$, d As Object, t, n#, sum#
Set d = CreateObject("scripting.dictionary")
ar = Sheet7.[b4].CurrentRegion '单元格区域装入数组，你选择b4按ctrl+a看是哪些区域
For r = 2 To UBound(ar) - 1
    st = ar(r, 1)
    If Len(st) Then '判断是否为空，等同于if st<>"" then
        d(st) = r '将大项位置装入字典
        ar(r, 6) = "" '清空合计，表中黄色单元格，这里可写可不写，写了更严谨些吧
    Else
        ar(r, 6) = ar(r, 4) * ar(r, 5) '若为空则算出每个小项的乘积
    End If
Next
'说明，for r = 2 to 10   ……………… next 循环完后r的值是11，此为特别强调
d(r) = r '记录下最后一行位置，也就是总计，等同于d(UBound(ar)) = r
t = d.items '字典items装入数组
Set d = Nothing '释放对象
For r = 0 To UBound(t) - 1 '在数组中循环，此数组记录着每个大项的位置
    n = 0 '此变量将存放每大项的合计
    For i = t(r) + 1 To t(r + 1) - 1 '在小项中循环
        n = n + ar(i, 6) '累加
    Next
    ar(t(r), 6) = n '将结果写入
    sum = sum + n '各大项累加
Next
ar(UBound(ar), 6) = sum '总计结果写入
Sheet7.[k4].Resize(UBound(ar), UBound(ar, 2)) = ar '数组写入单元格区域
End Sub

GUANGGE

xiangbaoan 发表于 2018-8-21 18:55
Sub test()
Dim ar, r&, i%, st$, d As Object, t, n#, sum#
Set d = CreateObject("scripting.diction ...

谢谢，老师。
非常感谢老师的回复。
我想先看明白程序说明，如有不懂的地方，再请您指导。
谢谢。