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

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

本文属原创文章，转载请联系我或者注明出处。