Board logo

標題: [發問] BOM表VBA [打印本頁]

作者: PJChen    時間: 2017-8-13 00:16     標題: BOM表VBA

大大們好,

以下圖片是對應欄位的來源,這個程式需求因為說明很長,所以我把程式需求說明放在檔案中。
[attach]27620[/attach]
這些動作我已做超過15次了,因為筆數超過5萬筆,目的檔又有很多公式在內,很花時間在等待及複製貼上,所以才會有一個中繼檔的出現,這可以減少程式run的時間.
檔案中已將大量資料刪除,且公式幾乎都已數值化或刪除,所以測試的時候會快很多.

[attach]27619[/attach]
作者: 准提部林    時間: 2017-8-13 16:24

說明文字很多, 已儘量看, 但眼睛受不了!!!
趁有些時間, 大約寫, 若有缺漏可能沒時間再修, 參考看看:
[attach]27623[/attach]

檔案只能用xls去寫, 自行去改程式碼!!!
作者: PJChen    時間: 2017-8-13 19:57

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

回復 2# 准提部林

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

1. 程式一開始有出現一個警告 [attach]27625[/attach],不知道對巨集有無影響?

2. 一按巨集鈕必須要出現一個詢問框,例如這樣的對話框 [attach]27624[/attach] ,這樣才能往下執行動作,我也才能知道程式要執行哪個選項!

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

4. 程式未執行完又出現一個異常 [attach]27626[/attach],所以實在也不知結果到底如何?

檔案中的說明, item 1~8 只是在
作者: PJChen    時間: 2017-8-13 20:02

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

回復 2# 准提部林

檔案中的說明, item 1~8 只是在
作者: 准提部林    時間: 2017-8-13 21:40

回復 3# PJChen


[attach]27628[/attach]
作者: PJChen    時間: 2017-8-13 23:42

回復 5# 准提部林

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

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的需求,但它會把資料清空再貼新的資料
作者: 准提部林    時間: 2017-8-14 10:24

回復 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
 
 
 
作者: PJChen    時間: 2017-8-18 22:35

回復 7# 准提部林
今天總算把程式改完並測試完畢,雖然只有一半的程式,還是感謝大大費心寫了這個程式.




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)