求一个VBA代码

rose810805

作为会计，工作需要整理BOM表，实在是个漫长过程，求大神赐一个VBA代码，感谢


BOM清单导出后，格式如表“BOM全表”。

每个月对BOM的需求情况不同，就像只取我需要的父项编号的BOM。需求的父项物料编号放在需求表里面。

希望得到的效果：当识别到需求时，可以把需要的BOM单独列为一个表格，格式不变。

注意每个BOM的行数不同，但表头只有每个BOM的第一行有

先谢谢大神们了

rose810805

补充下，如果需求里面有10个BOM代码，就需要对应的10个工作表分别放需要的BOM

shiruiqiang

洋洋洒洒一大堆，就是“bom全表”的另类拆分吧

rose810805

shiruiqiang 发表于 2024-2-16 21:39
洋洋洒洒一大堆，就是“bom全表”的另类拆分吧

是的，大神能帮忙吗？

yynrzwh

求VBA代码.zip (31.79 KB, 下载次数: 18)

2024-2-16 21:40 上传

点击文件名下载附件

明天会更好zj

哈哈

rose810805

yynrzwh 发表于 2024-2-16 21:40

感谢大神啊祝大神新年鸿运当头呀

rose810805

明天会更好zj 发表于 2024-2-16 21:42

感谢大神，一下子2个代码，我慢慢用啊祝大神新年芝麻开花节节高

shiruiqiang

3190496160

Sub 拆分()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Application.DisplayAlerts = False
For Each sht In Sheets
    If sht.Index > 2 Then
        sht.Delete
    End If
Next sht
Application.DisplayAlerts = True
With Sheets("需求")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "需求表为空！": End
    ar = .Range("a1:a" & r)
End With
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        d(ar(i, 1)) = ""
    End If
Next i
With Sheets("BOM全表")
    rs = .Cells(Rows.Count, 5).End(xlUp).Row
    If rs < 2 Then MsgBox "BOM全表为空！": End
    br = .Range("a1:o" & rs)
    For i = 2 To UBound(br)
        If br(i, 1) <> "" Then
            If d.exists(br(i, 1)) Then
                m = .Cells(i, 1).End(xlDown).Row
                If m > rs Then
                    m = rs + 1
                Else
                    m = m
                End If
                .Copy after:=Sheets(Sheets.Count)
                Set sh = ActiveSheet
                sh.Name = br(i, 1)
                sh.Range("a2:o" & rs) = Empty
                .Range(.Cells(i, 1), .Cells(m - 1, 15)).Copy sh.[a2]
            End If
        End If
    Next i
End With
Application.ScreenUpdating = True
MsgBox "拆分完毕！"
End Sub