零部件各层级总成至顶级零件重量VBA卷积（已知所有单件重量）

kuangfengsj

各位大神，求助，请问如何实现零部件各层级总成至顶级零件重量VBA卷积（已知所有单件重量），之前公式法象山海鲜版主已经给了,见链接http://club.excelhome.net/thread-1469729-2-1.html，然后在本论坛也见到了自定义函数的方法，只是代码及参数都比较长，不知道有没有VBA代码计算方式。

一把小刀闯天下

'终于看明白了，汇总时还有考虑数量，，，

Option Explicit

Sub test()
  Dim arr, sum(99), i, j, p
  arr = [a1].CurrentRegion.Offset(1).Resize(, 8).Value
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  p = arr(UBound(arr, 1) - 1, 1)
    For i = UBound(arr, 1) - 1 To 1 Step -1
    If arr(i, 1) >= p Then
      brr(i, 1) = arr(i, 8)
    Else
      brr(i, 1) = arr(i, 3) * sum(p)
      For j = arr(i, 1) + 1 To p
        sum(j) = 0
      Next
    End If
    sum(arr(i, 1)) = sum(arr(i, 1)) + arr(i, 3) * brr(i, 1)
    p = arr(i, 1)
  Next
  [k2].Resize(UBound(brr, 1)) = brr
  MsgBox "总质量:" & brr(1, 1)
End Sub

kuangfengsj

一把小刀闯天下 发表于 2020-6-24 11:35
'终于看明白了，汇总时还有考虑数量，，，

Option Explicit

果然强大，试了下，可以了。不过好像层级至第十层的时候，第九层的总成就没有计算

一把小刀闯天下

kuangfengsj 发表于 2020-6-24 15:30
果然强大，试了下，可以了。不过好像层级至第十层的时候，第九层的总成就没有计算

最多可以支持99级，完全够了

可以再上附件，估计回来的时候有跳级，比如10-->8，9会丢失，需要看你的结构，，，

kuangfengsj

一把小刀闯天下 发表于 2020-6-24 15:35
最多可以支持99级，完全够了

可以再上附件，估计回来的时候有跳级，比如10-->8，9会丢失，需要看你的 ...

这个比较深点的层级，应该是像您说的，跳级了，因为11级的可以

一把小刀闯天下

kuangfengsj 发表于 2020-6-24 15:42
这个比较深点的层级，应该是像您说的，跳级了，因为11级的可以

你的层级是字符型的，够晕

在  ReDim brr(1 To UBound(arr, 1), 1 To 1) 下面插入下面3行：

-------------------

  For i = 1 To UBound(arr, 1) - 1
    arr(i, 1) = Val(arr(i, 1))
  Next

kuangfengsj

一把小刀闯天下 发表于 2020-6-24 15:49
你的层级是字符型的，够晕

在  ReDim brr(1 To UBound(arr, 1), 1 To 1) 下面插入下面3行：

这个因为好多BOM都是从PDM里导出的，所以基本都是加=号的

kuangfengsj

一把小刀闯天下 发表于 2020-6-24 15:49
你的层级是字符型的，够晕

在  ReDim brr(1 To UBound(arr, 1), 1 To 1) 下面插入下面3行：

OK了，谢谢，收假回来好好研究您的代码，学习下思路

ggmmlol

仅用一次单层循环搞定，不限层级。

Sub ggmmlol()
    Dim ar, r, br, cj, cjzllj#
    ar = Range("A1").CurrentRegion.Resize(, 8)
    r = UBound(ar)
    ReDim br(2 To r, 1 To 1)
    For i = r To 2 Step -1
        If ar(i, 1) = cj - 1 Then
            br(i, 1) = cjzllj
            cjzllj = 0
        Else
            br(i, 1) = ar(i, 8)
        End If
        cj = Val(ar(i, 1))
        cjzllj = cjzllj + Val(ar(i, 3)) * br(i, 1)
    Next
    Range("H2").Resize(r - 1) = br
End Sub

test.rar (30.81 KB, 下载次数: 8)

2020-6-24 18:35 上传

点击文件名下载附件

kuangfengsj

ggmmlol 发表于 2020-6-24 18:35
仅用一次单层循环搞定，不限层级。

Sub ggmmlol()

谢谢，吸收下