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

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

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

測試.rar (8.53 KB)

樓主熱帖

cclo0728

中學生 Rank: 2

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

26^#

發表於 2019-10-14 12:13 | 只看該作者

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

TOP

kim223824

中學生 Rank: 2

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

25^#

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