关于BOM表拆解VBA代码求助

wbhlc

大神们
    这几天学了好久，实在搞不定，求各位大神帮忙看看如何实现附件BOM表拆解：需求如下

1：sheet1:为总经营计划（父件料号）
2：sheet2：为ERP导出的BOM表
3：sheet3:想通过VBA的方式，实现一键拆解所有父件料号的下级子件物料，方便做BOM表拆解生产计划。

lisongmei

感觉你直接添加一个辅助列就行了吧。=IF(LEN(A2)=7,"父料","子料")

wbhlc

lisongmei 发表于 2024-7-10 10:45
感觉你直接添加一个辅助列就行了吧。=IF(LEN(A2)=7,"父料","子料")

谢谢提醒，一直困扰在VBA里去了，你这方式顿时打开了我的思路~先尝试~谢谢指导

longwin

请看附件....

cnmlgb9998

借楼练一下PQ。


是这个效果吗？

opiona

https://club.excelhome.net/threa ... tml?_dsign=41b48939

wbhlc

longwin 发表于 2024-7-10 11:56
请看附件....

兄弟，谢谢你~要的就是你这个效果

kyxfyzg

Sub test()
On Error Resume Next
Dim arr
arr = Sheets("客户需求").Range("a1").CurrentRegion
brr = Sheets("正向BOM").Range("a1").CurrentRegion
crr = WorksheetFunction.Transpose(Sheets("正向BOM").Range("a1", Sheets("正向BOM").Cells(Rows.Count, 1).End(xlUp)))
Sheets("BOM拆解计划").Activate
Columns("a:b").NumberFormatLocal = "@"
For j = 4 To UBound(arr)
h = WorksheetFunction.Match(CStr(arr(j, 1)), crr, 0)
hg = Range("a" & Rows.Count).End(xlUp).Row + 1
i = 0
Do
    Range("a" & hg + i) = brr(h + i, 1)
    Range("b" & hg + i) = brr(h + i, 2)
    i = i + 1
Loop Until brr(h + i, 15) = 0
Next j
End Sub

wbhlc

kyxfyzg 发表于 2024-7-10 15:25
Sub test()
On Error Resume Next
Dim arr

兄弟，你这串代码试了，在无限循环~可能还有BUG

wbhlc

longwin 发表于 2024-7-10 11:56
请看附件....

兄弟，你这串代码今天试产符合要求，但是数据超过58行之后就报错了