一、目的：透多進階篩選方式篩選出資料，自動彙整各"系列名稱"與"尺寸"數量與金額
題外話：在別間公司都是以料貨號管理的，可能女友服務的公司，同一系列名稱的產品有太多不同的尺寸了，但偏偏早期導入ERP時，料貨號管理沒把尺寸編進去，導致"人工作業無止境"，變成人在維護電腦，再請網友們看到"系列名稱"與"尺寸"時別覺得怪。
二、系統分析：
2.1 輸入資料：ERP匯出之各"系列名稱"之銷售數量與金額資料。
2.2 預期輸出：各"系列名稱"與各"尺寸"的金額。
2.3 半自動批次處理：
2.3.1 流程想法：
2.3.2 新增表單與相關欄位設計：
1.工作表2：建立公司內各系列與尺寸的列表，並額外增加加總數量與加總金額等欄位，準備給處理完後寫入資料用。
2.sheet1：輸入資料的工作表"sheet1"，預留1到8提供作進階篩選用，故輸入資料含標題從A9貼上，識別輸入資料所需行數：確定4行就夠。
3.工作表1：個彙整篩選結果金額與數量的"工作表1"，作為加總金額與數量使用。
2.3.3 各功能別vba 建置：
1.建立進階篩選(VBA)： 使用 RANGE 的AdvancedFilter 方法。
a.建立一個ACTIVEX 命令按鈕，並使用Click作物件觸發。
b.物件：CommandButton，建立在工作表表名sheet1
c.VBA 程式碼：
Private Sub CommandButton1_Click()
Dim data_range As Range, condition_range As Range '宣告資料與條件別RANGE物件
Set data_range = ActiveSheet.Range("A9").CurrentRegion '透過SET與CurrentRegion ，從a9儲存格開始抓使用的資料區域
Set condition_range = ActiveSheet.Range("A1:B2") '條件區域2個即可滿足"系列名稱"與各"尺寸"。要有標題與篩選內容。如果要增加篩選條件可以改成c2、d2以此類推
data_range.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=condition_range 'action 參數設定為xlFilterInPlace 表將資料留在原
Set data_range = Nothing '使用nothing 作物件釋放
Set condition_range = Nothing '使用nothing 作物件釋放
End Sub
d.進階篩選 測試：於A2與B2輸入玉石A7與10/10(儲存格要設定為文字)，點選進階篩選按鈕，當左邊欄數出現藍色字體即表示完成進階篩選。(參圖1)
圖1
2.恢復篩選：.ShowAllData
a.使用在建立一個ACTIVEX 命令按鈕，並使用Click作物件觸發，並撰寫 sheets("Sheet1").ShowAllData 即可取消進階查詢的結果。
b.物件：CommandButton，建立在工作表表名sheet1
c.VBA 程式碼：
Private Sub CommandButton2_Click() '復原篩選結果
Sheets("Sheet1").ShowAllData
End Sub
3.篩選結果複製：range.copy
a.建立一個ACTIVEX 命令按鈕，並使用Click作物件觸發，增加如c 的程式碼。
b.物件：CommandButton，建立在工作表表名sheet1
c.VBA 程式碼：
Private Sub CommandButton3_Click() 'copy
'複製前，先清除複製目的端工作表的資料，在此設定複製目的端工作表表名為"工作表1"
xx = Application.CountA(Sheets("工作表1").Range("a:a")) + 1 '取得工作表1的資料總數，怕XX=0出現錯誤，故最後再+1
Sheets("工作表1").Range("a1:k" & xx).Clear '清除"A1:K" XX的資料
'取得來源工作表最後一筆資料所在儲存格位置。
n = Sheets("Sheet1").Range("a" & 65536).End(xlUp).Row
Worksheets("Sheet1").Range("A9:k" & n).Copy _
Destination:=Worksheets("工作表1").Range("a1") '複製篩選結果到工作表1的A1
End Sub
4.彙整金額與數量：
a.建立一個ACTIVEX 命令按鈕，並使用Click作物件觸發，增加如c 的程式碼。
b.物件：CommandButton，建立在工作表表名工作表1
c.VBA 程式碼：
Sub CommandButton1_Click() 'run '注意需要把private拿掉歐，系統預設是sub前是有private的。
備註：有private僅能在單一工作表物件內做調用，無法跨物件作使用。
Sheets("工作表1").Activate
xx = Application.CountA(ActiveSheet.Range("a:a")) '計算工作表資料筆數
ActiveSheet.Range("o3") = 0
ActiveSheet.Range("o4") = 0
Total = 0
Total_num = 0
ActiveSheet.Range("o4") = Application.Sum(ActiveSheet.Range("d2:d" & xx)) '使用sum函數加總金額
ActiveSheet.Range("o3") = Application.Sum(ActiveSheet.Range("c2:c" & xx))'使用sum函數加總數量
End Sub
5.批次執行：
a.建立一個ACTIVEX 命令按鈕，並使用Click作物件觸發，增加如c 的程式碼。
b.物件：CommandButton，建立在工作表表名工作表1
c.VBA 程式碼：
Private Sub CommandButton4_Click() '批次處理
xx = Application.CountA(Sheets("工作表2").Range("a:a")) + 1 '工作表2資料筆數，+1是避免空白產生錯誤。
Sheets("工作表2").Range("C2:D" & xx).Clear '每次批次執行前，作清除"C2:D" XX的資料範圍清楚
For i = 2 To xx Step 1 '透過迴圈完成批次處理 i 步進值用來控制篩選條件與回寫位置。
Sheets("Sheet1").Range("a2") = ""
Sheets("Sheet1").Range("b2") = ""
Sheets("Sheet1").Range("a2") = Sheets("工作表2").Range("a" & i) '寫入篩選條件一
Sheets("Sheet1").Range("b2") = Sheets("工作表2").Range("b" & i) '寫入篩選條件二
Call CommandButton1_Click '執行篩選
Call CommandButton3_Click '執行複製
Call Sheets("工作表1").CommandButton1_Click '此部分要注意，因為要執行工作表1的CommandButton1_Click ，故CommandButton1_Click的Private字眼刪除。
Sheets("工作表2").Range("C" & i) = Sheets("工作表1").Range("o4") '回寫彙整數量
Sheets("工作表2").Range("D" & i) = Sheets("工作表1").Range("o3") '回寫彙整金額
Sheets("SHEET1").Activate
Next i
MsgBox "已完成批次處理"
End Sub
範例檔案有需要，再請留言。
進階篩選設定可參考筆者另外一篇：Excel 進階篩選 條件設定教學
留言列表
