BOM单树形转换父子型问题

zpy2

singzhou 发表于 2022-9-3 16:22
高手，用什么做的？EXCEL可以实现吗？没有看到附件

11楼在线工具

vba应该也可以的。。。

singzhou

zpy2 发表于 2022-9-3 17:18
11楼在线工具

vba应该也可以的。。。

大师，可否用VBA帮忙实现一下，跪谢！

jiaxinl

singzhou 发表于 2022-9-3 17:41
大师，可否用VBA帮忙实现一下，跪谢！

点击表中的箭头      但没有按你的顺序排序

1. Public Sub 树转父子()
   
2. 
   
3.     Dim dicA
   
4. 
   
5.     Dim dicB '用来去重
   
6. 
   
7.     Dim Arr, i&, j&, X&, Xrr(1 To 1000, 1 To 4)
   
8. 
   
9.     Set dicA = CreateObject("Scripting.Dictionary")
   
10. 
    
11.     Set dicB = CreateObject("Scripting.Dictionary")
    
12. 
    
13.     Arr = Sheets("Sheet1").Range("C1").CurrentRegion
    
14. 
    
15.     For i = 2 To UBound(Arr)
    
16. 
    
17.         dicA(0) = Arr(i, 1) '顶层
    
18. 
    
19.         dicA(Arr(i, 2)) = Arr(i, 3)
    
20. 
    
21.         s = dicA(Arr(i, 2) - 1) & "->" & Arr(i, 3)
    
22. 
    
23.         X = Arr(i, 4)
    
24. 
    
25.         If Arr(i, 2) = 1 Then
    
26. 
    
27.             X = Arr(i, 4)
    
28. 
    
29.         ElseIf Arr(i, 2) - Arr(i - 1, 2) = 1 Then
    
30. 
    
31.             X = X / Arr(i - 1, 4)
    
32. 
    
33.         ElseIf Arr(i, 2) <= Arr(i - 1, 2) Then
    
34. 
    
35.             For j = i To 2 Step -1
    
36. 
    
37.                 If Arr(i, 2) - Arr(j, 2) = 1 Then X = X / Arr(j, 4): Exit For
    
38. 
    
39.             Next
    
40. 
    
41.         End If
    
42. 
    
43.         dicB(s) = Array(dicA(Arr(i, 2) - 1), Arr(i, 3), X)
    
44. 
    
45. '        dicB(s) = Array(dicA(Arr(i, 2) - 1), Arr(i, 3), X, Arr(i, 2))
    
46. 
    
47.     Next i
    
48. 
    
49.     it = dicB.Items
    
50. 
    
51.     a = Application.Transpose(it)
    
52. 
    
53.     b = Application.Transpose(a)
    
54. 
    
55.     Range("P2").CurrentRegion.Offset(1).ClearContents
    
56. 
    
57.     Range("P2").Resize(UBound(b), UBound(b, 2)) = b
    
58. 
    
59. End Sub

复制代码

jiaxinl

singzhou 发表于 2022-9-3 17:41
大师，可否用VBA帮忙实现一下，跪谢！

其实你的意思类似这样

singzhou

jiaxinl 发表于 2022-9-3 18:05
其实你的意思类似这样

是的，基础数量不全是1，那VBA怎么实现，谢谢！

jiaxinl

singzhou 发表于 2022-9-3 18:18
是的，基础数量不全是1，那VBA怎么实现，谢谢！

我已经发了，在楼上

singzhou

jiaxinl 发表于 2022-9-3 17:58
点击表中的箭头      但没有按你的顺序排序

大师，高手。怎么在加按钮运行不能出结果。在VBE里面运行可以出结果？

singzhou

jiaxinl 发表于 2022-9-3 21:18
我已经发了，在楼上

谢谢大师，可以了。

xzcdcak

学习了。很厉害了。大家。

singzhou

jiaxinl 发表于 2022-9-3 17:58
点击表中的箭头      但没有按你的顺序排序

大师，见图片，运算结果不对，怎么是483只，应该是36*100-117=3483只才对，请帮忙检查一下，谢谢！（附件是文件）