如何讓料號能夠自動判定並複製去指定的工作表

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

1^# 跳轉到 »

發表於 2019-7-6 12:39 | 顯示全部帖子

簡化一下程式碼:
Sub test_20190702_1()
Dim i%, j%, xR As Range
Sheets(1).[A:C].Copy Sheets(4).[C:E] '複製全部資料至Sheet4(剩餘料號)
For i = 2 To 3
With Sheets(i)
      .[C:E].Clear '清除原有資料
      Set xR = Range(.[A1], .Cells(Rows.Count, 1).End(xlUp)) '進階篩選準則範圍
      Sheets(1).[A:C].AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=xR, CopyToRange:=.[C1], Unique:=False  '進階篩選複製
End With
For j = 2 To xR.Count
      Sheets(4).[C:C].Replace xR(j), "", Lookat:=xlWhole '依篩選準則文字, 將Sheet4料號取代為空白
Next j
Next i
On Error Resume Next '略過程式錯誤而不中斷
Sheets(4).[C:C].SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Sheet4 定位C欄[編輯>到>空白格]並刪除, 即為剩餘料號
On Error GoTo 0 '恢復程式錯誤檢測與警告
End Sub