返回列表 上一主題 發帖

[發問] BOM表VBA

[發問] BOM表VBA

大大們好,

以下圖片是對應欄位的來源,這個程式需求因為說明很長,所以我把程式需求說明放在檔案中。
對應欄位.jpg
2017-8-13 00:14

這些動作我已做超過15次了,因為筆數超過5萬筆,目的檔又有很多公式在內,很花時間在等待及複製貼上,所以才會有一個中繼檔的出現,這可以減少程式run的時間.
檔案中已將大量資料刪除,且公式幾乎都已數值化或刪除,所以測試的時候會快很多.

BOM表VBA.rar (516.42 KB)
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

說明文字很多, 已儘量看, 但眼睛受不了!!!
趁有些時間, 大約寫, 若有缺漏可能沒時間再修, 參考看看:
BOM表VBA_v1.rar (368.02 KB)

檔案只能用xls去寫, 自行去改程式碼!!!
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

本帖最後由 PJChen 於 2017-8-13 20:02 編輯

回復 2# 准提部林

大大,
不好意思,說明太簡略其實寫程式的人也無從著手,這個程式說明看似很長很多,其實作法並不繁複,只是一直在重複做著幾個動作(複製.貼上.篩選出重複資料),就因為是重複性動作,又很花時間,才想要用VBA...好像讓你有點痛苦了, sorry.

1. 程式一開始有出現一個警告
20170813.192820_執行BOM表巨集的警告.jpg
2017-8-13 19:51
,不知道對巨集有無影響?

2. 一按巨集鈕必須要出現一個詢問框,例如這樣的對話框
對話框.jpg
2017-8-13 19:44
,這樣才能往下執行動作,我也才能知道程式要執行哪個選項!

3. 所有複製的資料一定要先貼在中繼檔,但似乎沒有朝這個方向做,而直接貼在目的檔去了,因為它未出現詢問,所以也不知道它執行的是什麼!

4. 程式未執行完又出現一個異常
20170813.193116_執行出現異常.jpg
2017-8-13 19:54
,所以實在也不知結果到底如何?

檔案中的說明, item 1~8 只是在
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

本帖最後由 PJChen 於 2017-8-13 20:03 編輯

回復 2# 准提部林

檔案中的說明, item 1~8 只是在
20170813.200445.jpg
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 3# PJChen


BOM表VBA_v1(2007).rar (638.97 KB)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 5# 准提部林

大大,
不得不說,這真是太神奇,完全沒有看到檔案打開,它就做完了!
我先從中繼檔測試,測試完全正確後,最後才能以正式文件實做(這要到最後階段).
我測試了A. 全選 & B. 局部篩選 把結果(明細.sheet) PO上給你看..(因為2種結果都有,所以檔案有點大,需要分割)
全明細.part01.rar (550 KB) 全明細.part02.rar (550 KB) 全明細.part03.rar (550 KB) 全明細.part04.rar (213.24 KB)

A. 全選
1. 明細A欄的公式有很多出現#REF!
2. 明細.sheet 少了篩選鍵
3. 資料有漏抓的情形,以下3筆都是在每張sheet的第一筆
MM17010009,200-999-000-0005,加工件    領料
MRPO16030020,259-000-000-0023            採購
MSO17040007,141-122-001-0002              訂單

B. 局部篩選
1. 明細A欄的公式有很多出現#REF!
2. 明細.sheet 一樣沒有篩選鍵
3. 局部篩選為補充資料,所以沒有clear的需求,但它會把資料清空再貼新的資料
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 6# PJChen


A.局部篩選不清空:
  'If i = 1 Then LstSht.UsedRange.Offset(1, 0).EntireRow.Delete '明細先清空
  改為
  If i = 1 And FilterNum = 2 Then LstSht.UsedRange.Offset(1, 0).EntireRow.Delete '明細先清空
 
B.第一筆資料漏掉:
  For j = 1 To 10
    If Arr(i, j + 3) = "-" Then GoTo 101
    FClmn = Range(Arr(i, j + 3) & 1).Column
    'ErpUsedRng.Columns(FClmn).Offset(2, 0).Copy xEnd(1, j)
    
改為
    ErpUsedRng.Columns(FClmn).Offset(1, 0).Copy xEnd(1, j)
101: Next j
 
C.公式變成#REF:
With LstSht.UsedRange.Offset(1, 0)
  .Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlNo '明細表以B欄排序
  With .Columns(1)
     '.Formula = "=IF(B2="""",0/0,1/(1-(B2=B1)))"  '排除〔重覆〕公式
     
改為
     .Formula = "=IF(OR(OFFSET(A2,,1)="""",OFFSET(A2,,1)=OFFSET(A2,-1,1)),0/0,1)"  '排除〔重覆〕公式
     .Calculate  '公式重新計算
     On Error Resume Next
     .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete  '刪除重覆列資料(到.公式.錯誤值)
     On Error GoTo 0
     '其實上方公式只是用來刪除重覆,是可以清空的
     '.ClearContents →加入這一行清空公式
  End With
End With
LstSht.UsedRange.AutoFilter '←增加這一行,表頭成為〔篩選模式〕
LstBook.Save
 
D.BOM表篩選模式
With BomSht
  Intersect(.[D:M], .UsedRange.Offset(1, 0)).ClearContents '清除BOM表D:M欄資料
  .[D2:M2].Resize(UBound(Arr)) = Arr
  .UsedRange.AutoFilter '←增加這一行,表頭成為〔篩選模式〕
End With
 
 
 
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

回復 7# 准提部林
今天總算把程式改完並測試完畢,雖然只有一半的程式,還是感謝大大費心寫了這個程式.
請詳閱 論壇版規愛惜帳號,一起創造美好的學習討論空間。

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題