微信公眾號:excelperfect
本文接著講解Excel的篩選功能。
在Excel的「數據」選項卡的「排序和篩選」中,單擊「高級」命令按鈕,會彈出「高級篩選」對話框,進行相應的條件設置後,會篩選出符合要求的數據。
這是一個強大的功能,尤其是在VBA中。
我們先使用Excel的錄製宏工具錄製一段進行高級篩選操作的代碼,初步窺探其基本功能。
為避免大量工作表數據對理解的影響,仍以簡單的數據工作表為例。只需了解基本原理,就可以在含有大量數據的複雜工作表中靈活應用。
如下圖所示的工作表。我們需要將列A中不重複的姓名提取出來,放置在列G中。
在Excel的高級篩選中,有兩種方法。
第一種:在「高級篩選」對話框的「方式」中選擇「將篩選結果複製到其他位置」,「列表區域」選擇單元格區域A1:A9,「複製到」選擇單元格G1,選中「選擇不重複的記錄」,單擊「確定」。
第二種:先在單元格G1中輸入標題「學生姓名」,然後在「高級篩選」對話框的「方式」中選擇「將篩選結果複製到其他位置」,「列表區域」選擇單元格區域A1:D9,「複製到」選擇單元格G1,選中「選擇不重複的記錄」,單擊「確定」。
下圖展示了這兩種方法的過程:
可以看出,兩種方法的結果相同。但是,如果預先設置了標題,則可以選擇整個數據區域。因為Excel在每次篩選操作後,都會記住前一次的區域選擇,所以預先設置標題後,就用不著每次都要選擇不同的列表區域了。
上述操作錄製的代碼如下:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1:A9").AdvancedFilterAction:=xlFilterCopy, CopyToRange:=Range("G1" _
), Unique:=True
End Sub
Sub Macro2()
'
' Macro2 Macro
'
'
Range("A1:D9").AdvancedFilterAction:=xlFilterCopy, CopyToRange:=Range("G1" _
), Unique:=True
End Sub
從代碼中可以看出,參數Action設置為xlFilterCopy,表明將數據複製到由參數CopyToRange指定的區域,參數Unique設置為True,指定篩選不重複的數據。
下面,我們使用條件區域,篩選學生姓名為「張三」的數據記錄。如圖所示,條件區域為單元格區域F1:F2。在「高級篩選」對話框中選擇「將篩選結果複製到其他位置」,設置「列表區域」為A1:D9,「條件區域為「F1:F2」,複製到「H1」。單擊「確定」按鈕後的結果如圖。
上述操作錄製的代碼如下:
Sub Macro3()
'
' Macro3 Macro
'
'
Range("A1:D9").AdvancedFilterAction:=xlFilterCopy, CriteriaRange:=Range( _
"F1:F2"),CopyToRange:=Range("H1"), Unique:=False
End Sub
與本文開頭錄製的代碼相對,這次錄製的代碼中多了一個參數CriteriaRange,用來指定條件區域。
條件區域至少包含兩行,第一行包含一個或多個列標題,是想要在數據區域中篩選的內容,第二行包含的是想要獲取的數據。
AdvancedFilter方法的語法
AdvancedFilter方法用於基於條件單元格區域從數據表中篩選或者複製數據。語法如下:
Range對象.AdvancedFilter(Action,CriteriaRange,CopyToRange,Unique)
說明:
上述參數中,除參數Action必需外,其他都可選。
參數Action指定一個XlFilterAction常量,表明是直接將結果篩選在數據表所在位置,還是在將篩選結果複製到指定位置。xlFilterInPlace指定在數據表所在位置放置篩選結果,xlFilterCopy指定將篩選結果複製到指定位置。
參數CriteriaRange指定條件區域。如果忽略該參數,那麼表明沒有條件。
參數CopyToRange指定在參數Action設置為xlFilterCopy時結果複製到的目標單元格區域位置。如果參數Action設置為xlFilterInPlace,則忽略該參數。
參數Unique用來指定是否僅複製唯一值(即不重複的值)。設置為True用來篩選不重複的數據記錄,設置為False用來篩選滿足條件的所有數據記
錄。默認值為False。
下圖直觀地表明了各參數的意義。
示例1:獲取不重複值
下面的使用純代碼完成上文中篩選不重複值的兩種方法。
代碼1:獲取不重複的學生姓名,不預先在G1中輸入標題。
Sub testAdvancedFilter1()
Dim rngData As Range
Dim rngResult As Range
Dim lngLastRow As Long
'查找數據區域中最後一行
lngLastRow = Range("A" &Rows.Count).End(xlUp).Row
'設置被篩選的數據區域
Set rngData = Range("A1:A" &lngLastRow)
'設置複製數據的目標區域
Set rngResult = Range("G1")
'篩選不重複的學生姓名
rngData.AdvancedFilterAction:=xlFilterCopy, CopyToRange:=rngResult, Unique:=True
End Sub
代碼2:獲取不重複的學生姓名,預先在G1中輸入標題。
Sub testAdvancedFilter2()
Dim rngData As Range
Dim rngResult As Range
Dim lngLastRow As Long
Dim lngLastCol As Long
'查找數據區域中最後一行
lngLastRow = Range("A" &Rows.Count).End(xlUp).Row
'查找數據區域中最後一列
lngLastCol = Cells(1,Columns.Count).End(xlToLeft).Column
'設置被篩選的數據區域
Set rngData =Range("A1").Resize(lngLastRow, lngLastCol)
'設置複製數據的目標區域
Set rngResult = Range("G1")
'設置標題
Range("A1").CopyDestination:=Range("G1")
'篩選不重複的學生姓名
rngData.AdvancedFilterAction:=xlFilterCopy, CopyToRange:=rngResult, Unique:=True
End Sub
高級篩選應該是獲取不重複值最便捷的方法。
示例2:獲取兩列或多列組合後的不重複值
仍以上述工作表為例。現在,要篩選單元格區域A1:D9中的「學生姓名」和「科目」的不重複的組合。為使代碼簡便起見,我們先在要複製到的目標區域中輸入這兩個標題,即在單元格G1中輸入「學生姓名」,在單元格H1中輸入「科目」。
在VBE中輸入代碼:
Sub testAdvancedFilter3()
Dim rngData As Range
Dim rngResult As Range
'設置被篩選的數據區域
Set rngData = Range("A1:D9")
'設置複製數據的目標區域
Set rngResult = Range("G1:H1")
'篩選不重複的學生姓名和科目的組合
rngData.AdvancedFilterAction:=xlFilterCopy, CopyToRange:=rngResult, Unique:=True
End Sub
執行代碼後的效果如下圖:
細心的讀者可能會發現,上面示例中的3段代碼中AdvancedFilter方法語句相同:
rngData.AdvancedFilter Action:=xlFilterCopy,CopyToRange:=rngResult, Unique:=True
如果我們在代碼中設置好了相應的參數後,就可以反覆使用同樣的代碼!
示例3:根據條件區域篩選
本示例改寫上文中錄製的使用條件區域篩選的代碼,根據條件區域F1:F2篩選數據到單元格H1開始的區域。
Sub testAdvancedFilter3()
Dim rngData As Range
Dim rngCriteria As Range
Dim rngResult As Range
'設置被篩選的數據區域
Set rngData = Range("A1:D9")
'設置條件區域
Set rngCriteria = Range("F1:F2")
'設置複製數據的目標區域
Set rngResult = Range("H1")
'篩選滿足條件區域的不重複數據
rngData.AdvancedFilterAction:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngResult, _
Unique:=True
End Sub
示例4:設置邏輯條件篩選
繼續以上文中的工作表為例,使用邏輯運算連接多個條件來進行篩選。
我們可以看到,上圖中,當條件數據在同一列時,表明邏輯或的關係,即篩選該標題中包含所列中所有內容的數據;當條件數據在不同列時,表明邏輯與的關係,即篩選同時滿足列標題所在列內容組合的數據;當條件數據在不同列不同行時,篩選滿足列標題中所有內容的數據。代碼如下:
Sub testAdvancedFilter4()
Dim rngData As Range
Dim rngCriteria As Range
Dim rngResult As Range
'設置被篩選的數據區域
Set rngData = Range("A1:D9")
'設置條件區域
'篩選科目為語文或英語的數據
Set rngCriteria = Range("F1:F3")
'篩選學生姓名為張三且科目為數學的數據
'Set rngCriteria = Range("F1:G2")
'篩選學生姓名為李四或科目為英語的數據
'Set rngCriteria = Range("F1:G3")
'設置複製數據的目標區域
Set rngResult = Range("I1")
'篩選滿足條件區域的不重複數據
rngData.AdvancedFilterAction:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngResult, _
Unique:=True
End Sub
注釋掉相應的代碼後,可以執行不同條件組合的篩選。
也可以使用公式作為篩選條件。例如,在單元格F2中輸入公式:
=AND(科目="語文",成績>85)
用來查找數據區域A1:D9中,科目為「語文」並且成績大於85的數據記錄。條件區域為F1:F2,執行條件篩選後的結果如圖中單元格區域I1:L2所示。
說明:
Set rngCriteria = Range("F1:F2")
示例5:找出兩列中不相同的內容
如下圖所示的工作表,列A和列B中有相同的數據,也有不同的數據,要找出兩列中不同的數據並將這些單元格設置紅色背景色。
代碼如下:
Sub testAdvancedFilter5()
Dim lngLastRowA As Long, lngLastRowD AsLong
Dim lngLastRowB As Long, lngLastRowE AsLong
Dim rngA As Range, rngB As Range
Dim rngD As Range, rngE As Range
Dim rng As Range, rngTo As Range
'找到列A中的最後一行
lngLastRowA = Range("A" &Rows.Count).End(xlUp).Row
'設置列A中的數據區域
Set rngA = Range("A1:A" &lngLastRowA)
'找到列B中的最後一行
lngLastRowB = Range("B" &Rows.Count).End(xlUp).Row
'設置列B中的數據區域
Set rngB = Range("B1:B" &lngLastRowB)
'篩選列A找到不重複值並複製到列D
Range("A1:A" & lngLastRowA).AdvancedFilterAction:=xlFilterCopy, _
CopyToRange:=Range("D1"), Unique:=True
'找到列D中的最後一行
lngLastRowD = Range("D" &Rows.Count).End(xlUp).Row
'設置含有列A中的不重複值的區域
Set rngD = Range("D1:D" &lngLastRowD)
'篩選列B找到不重複值並複製到列E
Range("B1:B" &lngLastRowB).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("E1"), Unique:=True
'找到列E中的最後一行
lngLastRowE = Range("E" &Rows.Count).End(xlUp).Row
'設置含有列B中的不重複值的區域
Set rngE = Range("E1:E" &lngLastRowE)
'找到列A中有但列B中沒有的數據並設置紅色背景色
For Each rng In rngA
Set rngTo = rngE.Find(What:=rng)
If rngTo Is Nothing Then
rng.Interior.Color = RGB(225, 0, 0)
End If
Next rng
'找到列B中有但列A中沒有的數據並設置紅色背景色
For Each rng In rngB
Set rngTo = rngD.Find(What:=rng)
If rngTo Is Nothing Then
rng.Interior.Color = RGB(225, 0, 0)
End If
Next rng
'清除臨時存放不重複值的區域
rngD.Clear
rngE.Clear
End Sub
說明:
---
如果您對本文介紹的內容還有什麼好的示例,歡迎發送郵件給我:xhdsxfjy@163.com
也可以在本文下方留言,提出您的看法或建議。
本文屬原創文章,轉載請聯繫我或者註明出處。
關注《完美Excel》微信公眾帳號:
方法1—點擊右上角的按鈕,選擇「查看公眾號」,點擊關注
方法2—在添加朋友中搜索excelperfect
方法3—掃一掃下面的二維碼