超难的BOOM表求价格问题

讲古派

详见附件

讲古派

有没有人能解啊

yjh_27

讲古派 发表于 2017-3-22 11:33
有没有人能解啊

参见附件。

讲古派

yjh_27 发表于 2017-3-22 15:54
参见附件。

我的天啊.这么复杂.  我偿试消化一下.

blackttea1

能转为2003或2007版的，真想学一下，谢谢！

yjh_27

讲古派 发表于 2017-3-22 17:29
我的天啊.这么复杂.  我偿试消化一下.

模块  BOM矩阵转多级
sub aa()

是新写的，其他是原有的

yjh_27

blackttea1 发表于 2017-3-22 19:20
能转为2003或2007版的，真想学一下，谢谢！

移步：
BOM 大纲排序-自定义函数
http://club.excelhome.net/thread-1175717-1-1.html
(出处: ExcelHome技术论坛)

讲古派

yjh_27 发表于 2017-3-22 19:22
模块  BOM矩阵转多级
sub aa()

知识有限. 还是看不太懂.绕晕了.
我用了最死的方法,
可以求出3级.但3级都已经快绕晕了. 有办法简化吗.
Private Sub CommandButton2_Click()
arr = Range("a1").CurrentRegion
    ReDim brr(5 To UBound(arr)) As Currency
    For k = 5 To UBound(arr)
    brr(k) = arr(k, 8)  第8列是单价
        For j = 13 To UBound(arr, 2) 第13列开始是矩形BOOM表
            If arr(k, 1) = arr(1, j) Then
               For m = 5 To UBound(arr)
                   If arr(m, j) <> "" Then
                      brr(k) = brr(k) + arr(m, j) * arr(m, 8)
                      '--------------------------------------
                      For n = 13 To UBound(arr, 2)
                        If arr(m, 1) = arr(1, n) Then
                          For x = 5 To UBound(arr)
                              If arr(x, n) <> "" Then
                                  brr(k) = brr(k) + arr(x, n) * arr(x, 8)
                                  '-----------------------------------------------
                                    For y = 13 To UBound(arr, 2)
                                        If arr(x, 1) = arr(1, y) Then
                                            For Z = 5 To UBound(arr)
                                               If arr(Z, y) <> "" Then
                                                  brr(k) = brr(k) + arr(Z, y) * arr(Z, 8)
                                               End If
                                           Next
                                        End If
                                    Next
                                    '---------------------------------------------------
                              End If
                          Next
                        End If
                      Next
                      '----------------------------------------
                   End If
               Next
            End If
        Next
    Next
Range("k5:k" & UBound(arr)).Value = Application.WorksheetFunction.Transpose(brr)
Unload Me
End Sub

yjh_27

讲古派 发表于 2017-3-24 14:16
知识有限. 还是看不太懂.绕晕了.
我用了最死的方法,
可以求出3级.但3级都已经快绕晕了. 有办法简化吗. ...

对sub aa 注释如下

1. Sub aa()
   
2. '取原始数据
   
3. arr = [a5:i20]
   
4. brr = [j1:p4]
   
5. crr = [j5:p20]
   
6. '转换为标准多级BOM
   
7. bzrr = BOMMatrix2Multilevel(arr, brr, crr)
   
8. '统计价格
   
9. cbrr = BOMSum(bzrr, 2, , , , 7, UBound(arr, 2) + 1)
   
10. '转换为arr原始顺序
    
11. ReDim cb1rr(1 To UBound(cbrr), 1 To 1)
    
12. j = UBound(arr, 2) + 3
    
13. For i = 1 To UBound(cbrr)
    
14.     cb1rr(cbrr(i, j), 1) = cbrr(i, 7)
    
15. Next
    
16. '输出
    
17. Range("h5").Resize(UBound(cb1rr), 1) = cb1rr
    
18. End Sub
    

复制代码

如只是使用，只要会改输入、输出的几行代码即可
如要了解更多可将中间结果（数组）输出到工作表查看。

由于自定义函数要考虑通用，会绕些。
附件03版，增加树形输出

讲古派

yjh_27 发表于 2017-3-24 14:47
对sub aa 注释如下

谢谢. 我再看一下.