大神们，判断如何实现BOM整理

pengtao1314

大神们，看看下面表格数据如何使用判断实现


结果


其中L主料，Z替代料，两者均可使用

一把小刀闯天下

'你这BOM结构还挺奇怪的，，，

Option Explicit

Sub test()
  Dim arr, i, p, t, m
  arr = Sheets("数据").[a1].CurrentRegion.Offset(1).Resize(, 3)
  For i = 1 To UBound(arr, 1) - 1
    t = t & "/" & arr(i, 3)
    If arr(i + 1, 2) = "L" Or i = UBound(arr, 1) - 1 Then
      m = m + 1
      arr(m, 1) = arr(p + 1, 1): arr(m, 2) = arr(p + 1, 2): arr(m, 3) = Mid(t, 2)
      p = i: t = vbNullString
    End If
  Next
  With Sheets("结果").[a2]
    .Resize(UBound(arr, 1), 3).ClearContents
    .Resize(m, 3) = arr
  End With
End Sub

pengtao1314

一把小刀闯天下 发表于 2020-1-12 21:10
'你这BOM结构还挺奇怪的，，，

Option Explicit

非常牛逼，谢谢大神

pengtao1314

一把小刀闯天下 发表于 2020-1-12 21:10
'你这BOM结构还挺奇怪的，，，

Option Explicit

非常感谢，但看不懂数组，最好解释下，更感谢，当然这个要求可能有点过分

pengtao1314

一把小刀闯天下 发表于 2020-1-12 21:10
'你这BOM结构还挺奇怪的，，，

Option Explicit

大神这种又怎么实现的呀，我对数组不太了解，麻烦注释下可以吗？非常感谢！

一把小刀闯天下

'不会数组那就用字典，H列可以无序，，，

Option Explicit

Sub test()
  Dim i, dic
  Set dic = CreateObject("scripting.dictionary")
  For i = 2 To [h2].End(xlDown).Row
    If dic.exists(Cells(i, "h").Value) Then
      dic(Cells(i, "h").Value) = dic(Cells(i, "h").Value) & "\" & Cells(i, "i").Value
    Else
      dic(Cells(i, "h").Value) = Cells(i, "i").Value
    End If
  Next
  [l2].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
End Sub