如何展开全部子级并对应它的上一级

理想国2021

物料运算.rar (900.8 KB, 下载次数: 11)

2024-12-20 16:48 上传

点击文件名下载附件

，各位大师，怎么展开计划量不为0的产品BOM（展开全部子级，每个子级的上一级，带入计划量，运算子级需求）

chxw68

1. Private cpdm$, cpmc$
   
2. Sub test()
   
3.     Dim r%, i%
   
4.     Dim arr
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     With Worksheets("BOM")
   
7.         .AutoFilterMode = False
   
8.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.         sjk = .Range("a2:g" & r)
   
10.         For i = 1 To UBound(sjk)
    
11.             If Not d.exists(sjk(i, 1)) Then
    
12.                 Set d(sjk(i, 1)) = CreateObject("scripting.dictionary")
    
13.             End If
    
14.             d(sjk(i, 1))(sjk(i, 3)) = i
    
15.         Next
    
16.     End With
    
17.     With Worksheets("计划订单")
    
18.         .AutoFilterMode = False
    
19.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
20.         arr = .Range("a2:f" & r)
    
21.     End With
    
22.     m = 0
    
23.     For i = 1 To UBound(arr)
    
24.         cpdm = arr(i, 2)
    
25.         cpmc = arr(i, 3)
    
26.         If arr(i, 5) <> 0 Then
    
27.             Call dg(arr(i, 2), arr(i, 5))
    
28.         End If
    
29.     Next
    
30.     With Worksheets("问题")
    
31.         .UsedRange.Offset(2, 0).Clear
    
32.         If m > 0 Then
    
33.             With .Range("a3").Resize(m, UBound(brr, 2))
    
34.                 .Value = brr
    
35.                 .Borders.LineStyle = xlContinuous
    
36.             End With
    
37.         End If
    
38.     End With
    
39. End Sub
    
40. Sub dg(ByVal aa As Variant, ByVal jhl As Double)
    
41.     Dim i%
    
42.     Dim bb As Variant
    
43.     For Each bb In d(aa).keys
    
44.         i = d(aa)(bb)
    
45.         m = m + 1
    
46.         brr(m, 1) = cpdm
    
47.         brr(m, 2) = cpmc
    
48.         brr(m, 3) = aa
    
49.         brr(m, 4) = bb
    
50.         brr(m, 5) = sjk(i, 4)
    
51.         brr(m, 6) = sjk(i, 5)
    
52.         brr(m, 7) = sjk(i, 6)
    
53.         brr(m, 8) = sjk(i, 7)
    
54.         brr(m, 9) = jhl
    
55.         brr(m, 10) = brr(m, 7) * brr(m, 9)
    
56.         If d.exists(bb) Then
    
57.             Call dg(bb, brr(m, 10))
    
58.         End If
    
59.     Next
    
60. End Sub
    

复制代码

chxw68

练习递归。对递归还没有完全理解，运用还不太熟练。

z865593849

BOM展开 ，套娃

理想国2021

谢谢各位大侠帮助

z865593849

理想国2021 发表于 2024-12-21 22:38
谢谢各位大侠帮助

好用就多送送小花

理想国2021

chxw68 发表于 2024-12-20 20:03

怎么赠送花呀，教我一下

理想国2021

理想国2021 发表于 2024-12-21 22:38
谢谢各位大侠帮助

怎么送花呀，教我一下

chxw68

理想国2021 发表于 2024-12-23 08:51
怎么赠送花呀，教我一下

点击楼层右下方[评分]就可以送花。