測測你的VBA水平,多條件篩選資料並輸出到工作簿
參考連結: https://gewuweb.com/office365/3784.html
我的目標：讓中國的大學生走出校門的那一刻就已經具備這些office技能，讓職場人士能高效使用office為其服務。支援鵬哥，也為自己加油！
下面是一位群友付費請教的問題（感謝願為知識付費的同學），這裡分享給大家：
上面的資料經過了簡化，當然實際資料有很多。
要求：根據A列和C列的類別篩選資料並輸出到新的工作簿，工作簿的名字最好能辨識工作簿裡的資料是什麼。
比如，A列中菜市場1，對應的C列有屬於菜市場1的花生，那就篩選花生的資料輸出到新表，名字可以命名為菜市場1+花生，這樣通過工作簿的名字就能知道里面是什麼資料，菜市場1還對應有蘿蔔的資料，也要輸出的到一個新的工作簿中，命名為菜市場1+蘿蔔，其它菜市場的資料篩選同上。
如果手動篩選、複製貼上、另存為是不是會很麻煩呢？
這種時候就能體現出VBA的優勢了，而且用到的VBA知識也是入門級別的，所以你說學點VBA入門知識有用嗎？
想進一步提升Excel水平的同學，強烈建議大家學習下VBA入門教程。
言歸正傳，我們來看下上面的問題。
最終效果如下：
這裡分享兩種思路：
一、按照我們常規的操作，直接篩選，複製，新建一個工作簿，按照兩個篩選條件給其命名，然後把內容複製進去，儲存關閉，再繼續（迴圈操作）……
把上面的步驟直接寫成VBA程式碼即可。
篩選會用到Range的AutoFilter方法，即區域的自動篩選，此方法的第一個引數field表示篩選區域，這個好確定，Criteria1表示第一個篩選值，比如菜市場1，也可以新增第二個篩選值Criteria2，比如花生。
問題來了，每次迴圈操作時篩選值怎麼確定呢？
群裡有人想到先迴圈A列，根據A列的值新建工作簿並命名，當迴圈出來的值在資料夾中與已有的工作簿名字一樣時就繼續迴圈，若不一樣，則新建工作簿並命名。
建好工作簿後，迴圈出每個工作簿名字，根據工作簿的名字到資料來源裡找到對應的資料複製到本工作簿的工作表裡就OK了。
當然上述思路也行得通，通過判斷來列出A列不重複的類別並新建工作簿，每個工作簿的名字就可以作為篩選值Criteria1，但是我們的案例篩選值是兩個，A列和C列，當然變通下也是可以解決的。
如果大家掌握的字典的技術，就可以把通過字典把A列和C列不重複的值寫入字典，然後再迴圈出來這些唯一的值就是篩選值了，關鍵是迴圈出菜市場1時，第二個篩選值怎麼知道是花生或蘿蔔，而沒有花菜呢？
我們可以假設有花菜，第一個篩選值為菜市場1時，C列中不重複的關鍵字都篩選一遍，最後經過判斷有無記錄也可以得到想要的資料。根據迴圈出來的類別新建工作簿，然後把符合條件的資料裝進去即可。
這又是一種思路，當然上面這兩種思路最基本的方法都是使用了Range的AutoFilter方法，除此之外需要具備的知識點還有;
1、工作簿的新建，工作簿的命名、儲存並關閉。
2、Range區域的複製。
3、字典技術。
4、遍歷檔名的函式Dir。
5、If判斷語句，For迴圈語句等基本語句結構。
但是都是些基礎知識，只要大家認真學習下都可以搞明白。
二、第一種思路中使用的是自動篩選，其實就是相當於手工篩選，只是用程式碼控制了基礎操作而已，如果資料量大的話，估計執行起來會很卡，畢竟不停的篩選、複製、新建工作簿、改名字、開啟、貼上，儲存關閉等操作嘛！
我更喜歡的方法是，把A列和C列的值合併在一起寫入字典，這樣就可以知道到底有哪些類別了，而且避免了不必要的篩選，比如：菜市場1對應的沒有花菜，那就不必須篩選菜市場1，然後再篩選花菜了。
然後把每一行的資料合併後寫入到一個數組中，這樣這個陣列就是一維陣列，可以直接進行篩選，篩選的關鍵是通過拆分字典中每個key得到，經過兩次篩選就得到了想要的資料。
比如篩選菜市場1就得到了所有菜市場1的資料，在篩選後的結果中再篩選花生就會得到菜市場1中花生的資料，把這個資料放入一個新的工作簿，然後繼續迴圈……
囉裡囉嗦了一堆，也許還有人看不大懂，所以學習VBA一定動手寫，然後再參考別人的程式碼，總結並吸收不同的思路。
當然此案例還有其它思路，大家可以多發散思考下。
具體程式碼如下：
`Sub 篩選資料()` `Dim sh As Worksheet` `Dim arr, d As Object, i As Long` `Dim row1 As Long, col1 As Long, arr1(), n1 As Long, n2 As Long, str$` `Dim arr2, n3 As Long, c1$, c2$, arr3, arr4, arr5, n4 As Long, n5 As Long` `Dim pah$` ` '關閉系統提示` `Application.DisplayAlerts = False` ` '把資料區域讀取到arr中` `arr = Sheets(1).[a1].CurrentRegion` ` '建立一個字典d，把A列和C列不重複的篩選條件合併寫入到字典中` `Set d = CreateObject("scripting.dictionary")` `For i = 1 To UBound(arr)` `d(arr(i, 1) & "," & arr(i, 3)) = ""` `Next` ` '把資料區域每一行連線在一起寫入陣列arr1中，以便在其中進行篩選` `row1 = UBound(arr)` `col1 = UBound(arr, 2)` `ReDim arr1(1 To row1)` `For n1 = 1 To row1` `For n2 = 1 To col1` `str = str & "," & arr(n1, n2)` `Next n2` `arr1(n1) = Right(str, Len(str) - 1)` `str = ""` `Next n1` ` '拆分篩選條件並在arr1中篩選出符合條件的記錄` `arr2 = d.keys` `For n3 = 0 To d.Count - 1` `c1 = Split(arr2(n3), ",")(0)` `c2 = Split(arr2(n3), ",")(1)` `arr3 = Filter(arr1, c1)` `arr4 = Filter(arr3, c2)` ` '把符合條件的記錄放到新工作簿中` `ReDim arr5(0 To UBound(arr4), 0 To UBound(arr, 2) - 1)` `For n4 = 0 To UBound(arr4)` `For n5 = 0 To UBound(arr, 2) - 1` `arr5(n4, n5) = Split(arr4(n4), ",")(n5)` `Next n5` `Next n4` ` pah = ThisWorkbook.Path` `Workbooks.Add.SaveAs pah & "\" & Split(arr2(n3), ",")(0) & "+" & Split(arr2(n3), ",")(1)` `ActiveSheet.[a1].Resize(UBound(arr5) + 1, UBound(arr5, 2) + 1) = arr5` `ActiveWorkbook.Close 1` ` '清空arr3 , arr4, arr5以備下次裝入資料` `Erase arr3` `Erase arr4` `Erase arr5` ` Next n3` `'釋放字典物件` `Set d = Nothing` ` '開啟系統提示` `Application.DisplayAlerts = True` ` '啟用資料來源表` `Sheets(1).Activate` `End Sub`
向右滑動可以檢視完整程式碼。
程式碼中每段都要提示，懂VBA基礎的同學應該能看懂。
本節的分享就到這裡，祝大家每天都有進步。
1
線上課堂在逐漸完善中，歡迎您的光臨！