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

cclo0728

請教一個問題,我每天都要跑一個報表,而這個報表我每天都要做一些動作
(1)必須將EC及AC開頭的料號"整列資料"存至另一個工作表1,並將原始的工作表中的料號整列刪除
(2)必須將EA開頭的料號"整列資料"存放至工作表2,並將原始的工作表中的料號整列刪除
(3)剩餘的料號則在原始工作表上,第1與2刪除的空白列自動刪除

目前遇到問題是我1.2不會寫讓他自動判定,vb也是初學者
也查過許多網頁及看了很多討論,都沒有相關的討論
所以想教高手們,該如何寫這區塊,謝謝

測試.rar (8.53 KB)

下載次數: 14

2019-7-1 15:14

kim223824

回復 1# cclo0728

Sub test_20190702()
    Sheets("Sheet1(自動增加並放置AC及EC料").Select
    ROW1 = Cells(Rows.Count, "C").End(3).Row
    If ROW1 > 2 Then
        Range(Cells(1, "C"), Cells(ROW1, "E")).Clear
    End If
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    arr = Range("A2:A" & ROW1)
   
    ROW2 = Sheets(1).Cells(Rows.Count, "A").End(3).Row
   
    Sheets(1).Range("A1:C" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW1), CopyToRange:=Range( _
        "C1"), Unique:=False
   
    Columns("C:C").ColumnWidth = 14
    Columns("D:D").ColumnWidth = 16
    Columns("E:E").ColumnWidth = 8
   
    '==============================================================
    Sheets("Sheet2(自動增加並放置EA及EB料號").Select
   
    ROW1 = Cells(Rows.Count, "C").End(3).Row
    If ROW1 > 2 Then
        Range(Cells(1, "C"), Cells(ROW1, "E")).Clear
    End If

    Range("A1").Select
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    brr = Range("A2:A" & ROW1)
   
    Sheets(1).Range("A1:C" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW1), CopyToRange:=Range( _
        "C1"), Unique:=False
    Columns("C:C").ColumnWidth = 14
    Columns("D:D").ColumnWidth = 16
    Columns("E:E").ColumnWidth = 8

    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:A").ColumnWidth = 14
    Columns("B:B").ColumnWidth = 16
    Columns("C:C").ColumnWidth = 8
   
    Sheets(1).Range("A1:C" & ROW2).Copy Range("A1")
   
    For i = ROW2 To 2 Step -1
        
        For j = 1 To UBound(arr)
            If Cells(i, "A") Like arr(j, 1) Then
                Rows(i).Delete
                GoTo 1100
            End If
        Next
        For j = 1 To UBound(brr)
            If Cells(i, "A") Like brr(j, 1) Then
                Rows(i).Delete
                GoTo 1100
            End If
        Next
1100:
   
    Next

End Sub
測試.zip (20.84 KB)

下載次數: 10

2019-7-2 13:42

cclo0728

回復 2# kim223824
感謝前輩,前幾天已經看到回覆了,有些地方不懂
但這幾天忙於盤點,之後再請教,謝謝

kim223824

回復 3# cclo0728

目前幫你考慮的內容如下:
1. 作業方式是用 EXCEL中的  "進階篩選"，將你要的料號抬頭 選出。
2. 指定料號的頁數只有固定兩頁(頁面名稱不可更改)。
3. 但是指定料號的內容可能會變 (EA ==> EZ)，所以只要在A欄 KEYIN你要的料號抬頭就可以有新的料號 ex:  EZ*

准提部林

簡化一下程式碼:
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

Xl0000400.rar (14.78 KB)

下載次數: 19

2019-7-6 12:39

=====================================

kim223824

回復 5# 准提部林


    感謝，讓我又提升了。

cclo0728

回復 5# 准提部林
兩位前輩用的太神了~~~
我都看不懂你們所寫的:( :( :(
目前一直反覆看著妳們所寫的程式,邊寫邊GOOGLE查詢程式說明
再麻煩教學一次我將公司每日會跑的報表(未刪除欄位版補寄一次)再麻煩各前輩們
我說明一下這檔案的內容
1.第一個工作表(COPR172019070300070320190703000)這個是ERP系統報表自動產生的檔名每天名子都不一樣,所以跑出來的時候原始檔只會有"一個工作表",後面增加的工作表都是手動增加
1-1.欄位只要是藍色的區塊,都是不需要使用的,所以會刪除光光<=這段我會用巨集錄製,可以順利解決

2.D欄會手動插入一欄(如黃色區塊,D1字為"越南文")<=這段我會用巨集錄製,可以順利解決
2-1.第2個工作表(中越翻譯)是我這邊"新增"的,裡面是因為要用VLOOKUP比對"客戶名稱"要給外勞看的<=這段我會用巨集錄製及函數,可以順利解決

3.EC&AC(這個工作表也是手動新增的)
3-1.要將第一個工作表中的,EC及AC開頭料號移至此工作表

4.EA&EB(這個工作表也是手動新增的)
4-1.要將第一個工作表中的,EA及EB開頭料號移至此工作表

5.其他(這個工作表也是手動新增的)
5-1.剩餘的料號移至這一欄

6.設定列印範圍自動列印<=這段我上網查詢過要如何使用程式解決,但是每個工作表都各自列印(除了第一個系統產生的,其餘AC&EC,EA&EB,其他)再一起時我是沒試驗過

3-5這段我比較不懂的是,前輩們是如何去判定的(簡單說就是初學者看不太懂一堆程式語言)
我看了kim(是用工作表中的各料號開頭收尋),但看了准提部林的我就又更不懂了(雖然旁邊都有中文說明,但程度太弱沒辦法理解)
依K大之前設定的第一個分頁設個巨集按鈕,就只要將每個工作表內容刪除,按個按鈕就可以執行
但小弟我想了解這塊判定要如何執行

每日出貨預計表.rar (14.75 KB)

下載次數: 11

2019-7-8 11:59

cclo0728

回復 4# kim223824

1. 作業方式是用 EXCEL中的  "進階篩選"，將你要的料號抬頭 選出。
2. 指定料號的頁數只有固定兩頁(頁面名稱不可更改)。====>這個是我跑完報表手動增加的
3. 但是指定料號的內容可能會變 (EA ==> EZ)，所以只要在A欄 KEYIN你要的料號抬頭就可以有新的料號 ex:  EZ*

謝謝KIM大,我在去了解一下,你跟另一位大大的語法

cclo0728

回復 4# kim223824
請問可以教我這段是
arr = Range("A2:A" & ROW1)
因我查arr,google是查出來是array陣列的意思,但這個的用法看不太懂
If ROW1 > 2 Then還有這段
再麻煩指導一下

kim223824

回復 9# cclo0728

   
     ROW1 = Cells(Rows.Count, "C").End(3).Row           '知道C欄最後一個有資料的位置
     If ROW1 > 2 Then                                                            '如果ROW1 >2 表示 你的C欄有資料
          Range(Cells(1, "C"), Cells(ROW1, "E")).Clear                '將C欄~E欄都清除
     End If
     '==============================
     
     ROW1 = Cells(Rows.Count, "A").End(3).Row          '知道A欄最後一個有資料的位置
     arr = Range("A2:A" & ROW1)      '將A欄的資料放進arr的陣列變數裡面