返回列表 上一主題 發帖

[發問] BOM表VBA

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
1# 跳轉到 »
發表於 2017-8-13 16:24 | 顯示全部帖子
說明文字很多, 已儘量看, 但眼睛受不了!!!
趁有些時間, 大約寫, 若有缺漏可能沒時間再修, 參考看看:
BOM表VBA_v1.rar (368.02 KB)

檔案只能用xls去寫, 自行去改程式碼!!!

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
2#
發表於 2017-8-13 21:40 | 顯示全部帖子
回復 3# PJChen


BOM表VBA_v1(2007).rar (638.97 KB)

TOP

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
3#
發表於 2017-8-14 10:24 | 顯示全部帖子
回復 6# PJChen


Ａ．局部篩選不清空：
　　'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 '明細先清空
　
Ｂ．第一筆資料漏掉：
　　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
　
Ｃ．公式變成#REF：
With LstSht.UsedRange.Offset(1, 0)
　　.Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlNo '明細表以Ｂ欄排序
　　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
　
Ｄ．ＢＯＭ表篩選模式
With BomSht
　　Intersect(.[D:M], .UsedRange.Offset(1, 0)).ClearContents '清除ＢＯＭ表Ｄ：Ｍ欄資料
　　.[D2:M2].Resize(UBound(Arr)) = Arr
　　.UsedRange.AutoFilter　'←增加這一行，表頭成為〔篩選模式〕
End With
　
　
　

TOP

        靜思自在 : 【為善競爭】人生要為善競爭，分秒必爭。
返回列表 上一主題