Excel VBA解讀（53）：高級篩選——AdvancedFilter方法

本文接着講解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所示。

說明：

• 實現上述結果的VBA代碼與前文相同，隻需将設置條件區域的語句改為：

Set rngCriteria = Range('F1:F2')

• 上圖中條件公式單元格顯示#NAME?，是因為我們沒有在Excel中定義相應的名稱，但不影響使用和結果。

• 使用條件公式，條件區域的首行必須為空或者是與數據區域标題行不同的标題字段，例如本例中的“公式條件”。

示例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

說明：

• 本示例代碼雖有點長，但原理很簡單。首先使用高級篩選分别找出兩列的不重複值列表，然後列A中的值在列B的不重複值中查找，沒有找到就表明該值在列B中沒有，設置紅色背景色，對列B中的值進行同樣的操作。

• 本示例重點演示高級篩選查找不重複值，重在對前面一些知識點的練習。實際上可以将A列中的值作為Find方法的參數，直在列B中查找，反之亦然。

• 代碼中的Clear方法對單元格内容進行清除。

--------------------------------------

如果您對本文介紹的内容還有什麼好的示例，歡迎發送郵件給我：xhdsxfjy@163.com

也可以在本文下方留言，提出您的看法或建議。

本文屬原創文章，轉載請聯系我或者注明出處。