层级BOM依据父子关系转化模板

y1983y

各位大侠：您们好！
      由于近期公司要上ERP系统，需要将BOM参照层级BOM转换，请各位大佬给予帮助，谢谢大家。
      sheet1为产品BOM明细表,sheet2为整理后的样表。

3190496160

这种问题，期待高手

microyip

3190496160 发表于 2021-1-27 10:30
这种问题，非常复杂，别指望能在论坛得到义务解决，上淘宝或者找人有偿吧

这个可以可以

蓝桥玄霜

BOM转换的例子：

一把小刀闯天下

'根据规则输出应该少了3个，否则结果不确定，，，

Option Explicit

Sub test()
  Dim arr, i, j, m, cnt, p
  arr = Sheets("明细表").[a1].CurrentRegion.Offset(1).Value
  ReDim brr(1 To 10 * UBound(arr, 1), 1 To 11) As String
  For i = 1 To UBound(arr, 1) - 1
    For j = i + 1 To UBound(arr, 1)
      If Len(arr(i, 1)) + 2 = Len(arr(j, 1)) Then
        m = m + 1: cnt = cnt + 10
        brr(m, 1) = arr(i, 2): brr(m, 2) = arr(i, 7): brr(m, 3) = arr(i, 8)
        brr(m, 4) = 1: brr(m, 5) = "TAO"
        brr(m, 6) = cnt: brr(m, 7) = "L": brr(m, 8) = arr(j, 2)
        brr(m, 9) = arr(j, 7): brr(m, 10) = arr(j, 6)
        If i = 1 Then brr(m, 11) = "TAO" Else brr(m, 11) = "PC"
      End If
      If Len(arr(i, 1)) >= Len(arr(j, 1)) Then Exit For
    Next
    If m - p = 1 Then brr(m, 5) = "PC"
    If j > i + 1 Then m = m + 1
    cnt = 0: p = m
  Next
  Sheets("BOM收集模板").[m3].Resize(m, UBound(brr, 2)) = brr
End Sub

y1983y

一把小刀闯天下 发表于 2021-1-27 12:11
'根据规则输出应该少了3个，否则结果不确定，，，

Option Explicit

正确的，谢谢！我少复制了

y1983y

蓝桥玄霜 发表于 2021-1-27 11:54
BOM转换的例子：

惊动蓝版主，罪过罪过，非常感谢蓝版主的鼎力帮助。

y1983y

蓝桥玄霜 发表于 2021-1-27 11:54
BOM转换的例子：

蓝版主：您好！
      首先多谢您给予支持，但随着BOM子项增多就会满足不了要求，还望您能给予支持，谢谢！

y1983y

一把小刀闯天下 发表于 2021-1-27 12:11
'根据规则输出应该少了3个，否则结果不确定，，，

Option Explicit

侠圣：您好
首先多谢您给予支持，但随着BOM子项增多就会满足不了要求，还望您能给予支持，谢谢！

djt

这个题不需要vba，通过隶属关系，做出每个子项的父项，vlookup父项，得出父项名称，数量，剩下的拷贝粘贴就行了