BOM循环计算问题，请有空的大神伸伸援手

lzyxmj

现碰到一个棘手的问题，就是关于BOM计算的，语言不太好描述，上个图说明一下，请大神帮帮忙搞一下，或者给建议也行，谢谢！

一把小刀闯天下

'目测了一下应该差不多，，，

Option Explicit

Sub test()
  Dim arr, i, j, m, n, s, t, dic(2)
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = Range("a3:c" & Cells(Rows.Count, "b").End(xlUp).Row).Value
  For i = 1 To UBound(arr, 1)
    dic(0)(arr(i, 1)) = dic(0)(arr(i, 1)) & Space(1) & arr(i, 2)
    dic(1)(arr(i, 2)) = arr(i, 3)
  Next
  s = [f1].Value: n = [h1].Value
  If Not dic(0).exists(s) Then MsgBox s: Exit Sub
  ReDim arr(1 To UBound(arr, 1), 1 To 3)
  t = Split(dic(0)(s))
  Do
    For i = 1 To UBound(t)
      m = m + 1
      arr(m, 1) = t(i)
      arr(m, 2) = dic(1)(t(i))
      If dic(0).exists(t(i)) Then
        s = Split(dic(0)(t(i)))
        For j = 1 To UBound(s)
          dic(2)("a") = dic(2)("a") & Space(1) & s(j)
          dic(1)(s(j)) = dic(1)(s(j)) * arr(m, 2)
        Next
      End If
    Next
    If dic(2).Count > 0 Then t = Split(dic(2)("a")): dic(2).RemoveAll Else Exit Do
  Loop
  For i = 1 To m
    arr(i, 3) = arr(i, 2) * n
  Next
  [e3].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    d([f1].Value) = 300
l1:
    x = 0
    For j = 3 To UBound(arr)
        If d.exists(arr(j, 1)) Then
            d(arr(j, 2)) = d(arr(j, 1)) * arr(j, 3)
            arr(j, 1) = ""
            x = x + 1
        End If
    Next j
    If x > 0 Then GoTo l1
    d.Remove ([f1].Value)
    [e3].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
    [f3].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End Sub

gugudeai

请问父子编码什么关系。

zpy2

with recursive a (子,unit,total) as (values ('F001',1,300) union select 子项编码,子项用量*a.unit,子项用量*total from BOM清单明细表 join a on a.子=父项编码) select * from a

一把小刀闯天下

zpy2 发表于 2021-5-12 19:37
with recursive a (子,unit,total) as (values ('F001',1,300) union select 子项编码,子项用量*a.unit,子 ...

没搞懂一行代码就能解决一个问题的，，，

zpy2

一把小刀闯天下 发表于 2021-5-12 19:58
没搞懂一行代码就能解决一个问题的，，，

没法啊，不懂算法，只能用sql的api

一把小刀闯天下

zpy2 发表于 2021-5-12 20:41
没法啊，不懂算法，只能用sql的api

这种问题一般都会用深度搜索去解决的，你这代码行按单词来看recursive是使用了递归，确实很强大。这论坛看到过很多人用SQL语句去解决问题的，但没看到过有这用法的。

zpy2

一把小刀闯天下 发表于 2021-5-12 20:57
这种问题一般都会用深度搜索去解决的，你这代码行按单词来看recursive是使用了递归，确实很强大。这论坛 ...

过奖了，你的算法才是真正的强大。
这个recursive应该就是深度搜索递归封装好的，我直接拿来主义，套一下。

一把小刀闯天下

zpy2 发表于 2021-5-12 21:02
过奖了，你的算法才是真正的强大。
这个recursive应该就是深度搜索递归封装好的，我直接拿来主义，套一 ...

哪里，我这是边学边凑，因为没有层级输出要求所以用字典凑了一个。

觉得网页版的通用性会好的多，我是学不会，没办法。

zopey

Sub dg(name)
If Not dic.exists(name) Then Exit Sub
For i = 1 To dic(name).childs.Count
    k = k + 1
    brr(k, dic(name).level) = dic(name).childs(i)
    brr(k, 0) = dic(name).cnt * dic(dic(name).childs(i)).cnt
    dic(dic(name).childs(i)).cnt = brr(k, 0)
   
    brr(1, dic(name).level) = brr(1, dic(name).level) + 1
   
    If dic.exists(dic(name).childs(i)) Then dic(dic(name).childs(i)).level = dic(name).level + 1
    Call dg(dic(name).childs(i))
Next
End Sub

BOM结构.rar (70.71 KB, 下载次数: 16)

2021-5-12 21:49 上传

点击文件名下载附件