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

帖子: 75
主題: 8
精華: 0
積分: 109
點名: 0
作業系統: windows XP
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2015-4-19
最後登錄: 2024-8-10

2^#

發表於 2019-7-2 13:42 | 只看該作者

回復 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)

帖子: 53
主題: 8
精華: 0
積分: 90
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 20
註冊時間: 2019-4-30
最後登錄: 2023-4-25

3^#

發表於 2019-7-4 08:04 | 只看該作者

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

帖子: 75
主題: 8
精華: 0
積分: 109
點名: 0
作業系統: windows XP
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2015-4-19
最後登錄: 2024-8-10

4^#

發表於 2019-7-6 10:32 | 只看該作者

回復 3# cclo0728

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

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

5^#

發表於 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

Xl0000400.rar (14.78 KB)

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

帖子: 75
主題: 8
精華: 0
積分: 109
點名: 0
作業系統: windows XP
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2015-4-19
最後登錄: 2024-8-10

6^#

發表於 2019-7-6 13:29 | 只看該作者

回復 5# 准提部林

感謝，讓我又提升了。

帖子: 53
主題: 8
精華: 0
積分: 90
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 20
註冊時間: 2019-4-30
最後登錄: 2023-4-25

7^#

發表於 2019-7-8 12:08 | 只看該作者

回復 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)

帖子: 53
主題: 8
精華: 0
積分: 90
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 20
註冊時間: 2019-4-30
最後登錄: 2023-4-25

8^#

發表於 2019-7-8 12:11 | 只看該作者

回復 4# kim223824

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

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

帖子: 53
主題: 8
精華: 0
積分: 90
點名: 0
作業系統: windows
軟體版本: 7
閱讀權限: 20
註冊時間: 2019-4-30
最後登錄: 2023-4-25

9^#

發表於 2019-7-19 17:11 | 只看該作者

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

帖子: 75
主題: 8
精華: 0
積分: 109
點名: 0
作業系統: windows XP
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 高雄
註冊時間: 2015-4-19
最後登錄: 2024-8-10

10^#

發表於 2019-7-20 13:31 | 只看該作者

回復 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的陣列變數裡面