Board logo

標題: 如何讓料號能夠自動判定並複製去指定的工作表 [打印本頁]
作者: cclo0728    時間: 2019-7-1 15:14     標題: 如何讓料號能夠自動判定並複製去指定的工作表

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

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

[attach]30970[/attach]
作者: kim223824    時間: 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
[attach]30979[/attach]
作者: cclo0728    時間: 2019-7-4 08:04

回復 2# kim223824
感謝前輩,前幾天已經看到回覆了,有些地方不懂
但這幾天忙於盤點,之後再請教,謝謝
作者: kim223824    時間: 2019-7-6 10:32

回復 3# cclo0728

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

[attach]31000[/attach]


=====================================
作者: kim223824    時間: 2019-7-6 13:29

回復 5# 准提部林


    感謝，讓我又提升了。
作者: cclo0728    時間: 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大之前設定的第一個分頁設個巨集按鈕,就只要將每個工作表內容刪除,按個按鈕就可以執行
但小弟我想了解這塊判定要如何執行

[attach]31003[/attach]
作者: cclo0728    時間: 2019-7-8 12:11

回復 4# kim223824

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

謝謝KIM大,我在去了解一下,你跟另一位大大的語法
作者: cclo0728    時間: 2019-7-19 17:11

回復 4# kim223824
請問可以教我這段是
arr = Range("A2:A" & ROW1)
因我查arr,google是查出來是array陣列的意思,但這個的用法看不太懂
If ROW1 > 2 Then還有這段
再麻煩指導一下
作者: kim223824    時間: 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的陣列變數裡面
作者: cclo0728    時間: 2019-7-22 07:56

回復 10# kim223824
謝謝,我在繼續研究一下
作者: cclo0728    時間: 2019-7-26 08:12

回復 10# kim223824
請問我的判斷料號有辦法,寫在程式裡面嗎?
目前kim是寫在A欄位,但我想了解一下是否可以改寫在程式內
再麻煩教導一下,謝謝
作者: 准提部林    時間: 2019-7-26 11:12

回復 12# cclo0728

兩種模式:
[attach]31077[/attach]
作者: cclo0728    時間: 2019-7-26 13:56

回復 13# 准提部林

謝謝,准提大,我等等研究
但是我剛剛遇到一個問題
我將系統的報表整頁複製到第一個工作表(ERP資料),接著我用KIM大的程式跑,就會有異常
但我不要從我的報表複製過來的話,只是用原本KIM寫的,就不會有問題
是哪裡出錯了?

測試檔是KIM那時候寫的,我有改過一些[attach]31080[/attach]
報表檔是我將系統的資料貼過去的[attach]31079[/attach]
作者: 准提部林    時間: 2019-7-26 14:21

回復 14# cclo0728


"品    號"
"品       號"

兩表a1文字有差異~~
作者: cclo0728    時間: 2019-7-26 14:26

回復 15# 准提部林
太感謝啦~~~我早上對到剛剛,對到眼睛脫窗
謝謝,沒想到是那個有問題
作者: cclo0728    時間: 2019-7-26 15:00

回復 15# 准提部林

不好意思,再請教一個問題
我在測的時候,第sheet1跟sheet3都可以跑得出來
但sheet2的畫面,他只會跑一個料號,一整排的資訊會出不來
再麻煩指導一下[attach]31081[/attach]
作者: cclo0728    時間: 2019-7-26 15:25

回復 15# 准提部林
准提大,好像是我的EXCEL有問題,我重開後就正常了
不好意思
作者: cclo0728    時間: 2019-7-26 18:06

回復 15# 准提部林

請問我在sheet3中,要如何判定除了sheet1跟sheet2有的刪除
之前kim大的,我可以修改
但料號現在跑到F欄,程式好像就無法作動
在不影響欄位的狀態下,該如何修改,謝謝[attach]31083[/attach]
作者: kim223824    時間: 2019-8-3 10:31

回復 19# cclo0728

你在把你的需求寫清楚一點，目前SHEET3已經可以刪除sheet1/sheet2的品號。
[attach]31111[/attach]
作者: cclo0728    時間: 2019-8-5 09:34

回復 20# kim223824
感謝KIM,我這邊已經完成了
但就卡在公司的EXCEL是大陸的WPS,無法執行自動列印功能(在網路上案例中)
感謝你跟准大的技術指導,謝謝
作者: cclo0728    時間: 2019-10-8 17:04

回復 20# kim223824

請教KIM大
我在VBA那邊想改成收尋"土"這個字,但是跑出來不是空白,就是只有日期
是那邊沒有改好,麻煩指點一下,謝謝
作者: kim223824    時間: 2019-10-9 16:03

回復 22# cclo0728


    [attach]31329[/attach]
作者: cclo0728    時間: 2019-10-9 16:42

回復 23# kim223824
感謝,我忘記廠商名稱要符合第一頁比對的要點了:(
另外想請教一個問題,有辦法依廠商顯示出較多時,自動移置新增分頁嗎?
如土在第一頁有3個出現,花可能出現2個,其他可能只出現1次,抓取較多數或前幾名直接分頁新工作表
作者: kim223824    時間: 2019-10-10 11:44

回復 24# cclo0728

Sub 各別將廠商分頁()
    f1 = Sheets.Count   '判斷現在有幾頁
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    If ROW1 > 2 Then
        Range(Cells(1, "A"), Cells(ROW1, "B")).Clear
    End If

    If f1 > 3 Then  '判斷頁面大於3頁 表示有原來的資料 刪除
        For i = f1 To 4 Step -1         '從最後一頁往前 刪除
            Application.DisplayAlerts = False '關閉提醒
            Sheets(i).Delete
            Application.DisplayAlerts = True   '開啟提醒
        Next
    End If
   
    ROW1 = Sheets("欠料").Cells(Rows.Count, "C").End(3).Row
    Sheets("欠料").Range("B1:B" & ROW1).Copy Range("A1")
   
    Range("B2:B" & ROW1) = "=COUNTIF(A:A,A2)"
    Range("B2:B" & ROW1).Value = Range("B2:B" & ROW1).Value
   
    '排序 大到小============
    ActiveWorkbook.Worksheets("更新2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("更新2").Sort.SortFields.Add Key:=Range("B2:B" & ROW1), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("更新2").Sort
        .SetRange Range("A1:B" & ROW1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    '移除重複========================
    ActiveSheet.Range("$A$1:$B$" & ROW1).RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlYes
   
    ROW1 = Cells(Rows.Count, "A").End(3).Row
   
    arr = Range("A2:B" & ROW1)
   
    ROW2 = Sheets(1).Cells(Rows.Count, "A").End(3).Row
   
    '新增頁面==============================
    For i = 1 To UBound(arr)
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(i + 3).Name = arr(i, 1)
        Range("A1").Value = "客戶簡稱"
        Range("A2").Value = arr(i, 1)
        
        ROW3 = Cells(Rows.Count, "A").End(3).Row
        '進階篩選===============================
        Sheets(1).Range("A1:AA" & ROW2).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:=Range("A1:A" & ROW3), CopyToRange:=Range( _
        "C1"), Unique:=False
        Range("A:B").Delete
    Next

    Sheets("更新2").Select

    ROW3 = Cells(Rows.Count, "A").End(3).Row
   
    Range(Cells(1, "A"), Cells(ROW3, "B")).Clear
   
End Sub


    [attach]31332[/attach]
作者: cclo0728    時間: 2019-10-14 12:13

回復 25# kim223824
感謝KIM,想再請教
1.公司的客戶別很多,如何排定前幾大筆數較多的自動分頁出來(例如我只要前三名,後面的不用自動分頁)
2.在欠料表中,分頁出來後能夠將原本欠料表刪除嗎?
3.假如我用樞紐跑一開始的欠料,有辦法跟第一個問題一樣,用樞紐抓總筆數?(在更新2頁是不是可以不用COUNTIF?
4.欄位中有一個叫預計開工,因公司同仁都會排序日期小到大,假設以今天日期+1的話,也就是20191015之後的後面資料能夠自動刪除嗎
抱歉問題有點多,但想很久查GOOGLE也查不太到,再麻煩指點



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