帖子: 455
主題: 111
精華: 0
積分: 563
點名: 70
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2025-4-9

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2017-1-21 15:16 | 只看該作者

[發問] 如何比對2個BOM表，並插入列並齊

請教各位先進
1.BOM有"設變"狀況，每次設變不是會新增子階料號，不然就是會減少子階料號
2.我現在是用手動的方式依序按照階層排列
3.當設變前與設變後比對BOM，設變後的BOM有多一子階，我在設變前的BOM就插入1列--> 如何用VBA幫忙自動判斷並插入列
4.當設變前與設變後比對BOM，設變前有多一子階，我在設變後的BOM就插1列--> 如何用VBA幫忙自動判斷並插入列

是否可以使用Excel VBA 幫忙協助判讀，A欄與G欄的差異，並自動插入一列，讓設變前/後是可以比照的
P.S會有不同的產品，故資料列範圍會有變化

感謝各位先進的教導!

比較2個BOM表.rar (39.66 KB)

樓主熱帖

Just do it.

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-2-15

2^#

發表於 2017-1-23 13:06 | 只看該作者

本帖最後由准提部林於 2017-1-23 13:10 編輯

資料必須[排序]的:

Sub TEST()
Dim xArea As Range, xR As Range, xF As Range, xG As Range, G%
Set xArea = Range([A3], Cells(Rows.Count, 1).End(xlUp))
Application.ScreenUpdating = False
For Each xR In xArea
If xR = "" Or xR = xR(1, 7) Then GoTo 101
Set xF = [G:G].Find(xR, Lookat:=xlWhole)
If xF Is Nothing Then GoTo 101
G = xR.Row - xF.Row
If G > 0 Then Set xG = xF Else Set xG = xR
xG.Resize(Abs(G), 5).Insert Shift:=xlDown
101: Next
End Sub

複製代碼

Xl0000009.rar (29.67 KB)

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 70
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2025-4-9

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

3^#

發表於 2017-1-23 19:12 | 只看該作者

回復 2# 准提部林

准提部林，真的太感激你了，解決了一大煩惱。
我會好好看一下你的語法，有問題再跟你請教。
Thank you very much !

Just do it.

TOP

jsc0518

高中生 Rank: 3 Rank: 3

帖子: 455
主題: 111
精華: 0
積分: 563
點名: 70
作業系統: Windows 10
軟體版本: Office 2019
閱讀權限: 50
性別: 男
註冊時間: 2013-11-7
最後登錄: 2025-4-9

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章論壇贊助勳章

4^#

發表於 2017-1-24 12:25 | 只看該作者

回復 2# 准提部林

Dear 准提部林，我改過欄位編號後，並修改過程式碼，結果有異常，是否哪裡需做修訂?

Sub TEST()
Dim xArea As Range, xR As Range, xF As Range, xG As Range, I%
Set xArea = Range([A3], Cells(Rows.Count, 1).End(xlUp))
Application.ScreenUpdating = False
For Each xR In xArea
If xR = "" Or xR = xR(1, 9) Then GoTo 101
Set xF = [I:I].Find(xR, Lookat:=xlWhole)
If xF Is Nothing Then GoTo 101
I = xR.Row - xF.Row
If I > 0 Then Set xG = xF Else Set xG = xR
xG.Resize(Abs(I), 5).Insert Shift:=xlDown
101: Next
End Sub