VBA实战技巧精粹001:关于高级筛选功能的学习及VBA实现

一、高级筛选功能的学习与掌握

以前从未用过高级筛选，原因就是不会，试了好多次，总是在将筛选结果得到其他区域时提示：只能将复制到筛选后的活动工作表，搞了半天也没明白是什么意思。

到网上查了一下，一位仁兄的话点醒了我。摘录如下：

高级筛选只能将数据复制到活动的单元格。所以要在复制到的位置上（包括原表或新表中）进行筛选操作，而不是数据表上。

也就是说不论你是在原有区域显示筛选结果还是将筛选结果复制到其他位置上，必须在筛选结果保存的目标表进行操作（筛选）。

这样就明白了:需要你先定好想在哪个地方显示你的筛选结果。

问题提出：将1到20班的学生名单提取到sheet1表中，要求包括所有学生。

第一步：创建条件区域，需要按班级筛选，故如图所示：



由于需要在sheet1表中存储筛选结果，所以在活动工作表为sheet1前提下，数据→筛选→高级筛选，弹出对话框：



点选将筛选结果复制到其他位置，并重新设定列表区域、条件区域、复制到，注意使用绝对引用，这样可以避免筛选结果不符要求。







点确定即可在A4单元格起得到筛选结果。



若勾选“选择不重复的记录”呢？因为上表明显的得到了两个11班的学生，如果只想要不重复的记录，因为这样可以明显的是有作用的。

明白一个地方，所谓“选择不重复记录”中的记录是指什么？条件对应的单元还是整行？是整行，而不是只针对条件中的字段。当然这有你所指定的列表区域有关。


可以看到，筛选后的结果比左边少了一行，因为第1行与第2行是完全相同的，所以勾选“选择不重复的记录”后，就把完全相同的行给除掉了，当然这是因为我的列表区域选择的是全部。

2.VBA实现

以上最终的效果截图:


注意没有勾选"选择不重复的记录".

其VBA代码非常简单:

Option Explicit

Sub Macro1()
'
' Macro1 Macro
' 宏由 微软用户 录制，时间: 2011-4-9
'

'
' Sheets("理科").Range("A1:K89").AdvancedFilter action:=xlFilterCopy, _
' criteriarange:=Range("A1:B2"), copytorange:=Range("A4"), unique:=False

Sheets("理科").Range("A1:K89").AdvancedFilter action:=xlFilterCopy, criteriarange:=Range("A1:B2"), copytorange:=Range("A4"), unique:=False
End Sub

上面的代码应该比较好读些.解释如下:

①由于想对sheets("理科")进行筛选,所以应写成

Sheets("理科").Range("A1:K89").AdvancedFilter

即为对理科工作表的A1:K89进行高级筛选.不要Sheets("理科")不行吗?不行!因为必须在筛选结果保存的目标表进行操作（筛选）。所以真实的活动工作表是Sheets("sheets1"),所以必须加Sheets("理科").

那么是想将筛选的结果保存在原表(理科)中呢还是另存到新表中呢?一般情况下都是将结果保存到新表中,故有:

②acction:=xlFilterCopy

即动作为将筛选的结果复制到新表中.

那么复制的条件是什么呢?一般情况下应该指定条件,不然就失去高级筛选的意义了,故有:

③criteriarange:=Range("A1:B2")

即条件为新表(拟保存结果的表,同时记录条件)中的指定区域,注意A1所在行为列标!

到这儿就将需要进行筛选的数据表/区域/条件,全都指定完毕,那么是不是需要再指定结果保存的起始位置呢?肯定需要,故有:

④copytorange:=Range("A4")

即用来放置筛选的结果.

那么是否需要保持唯一的记录呢?也就是说是否需要"选择不重复的记录"呢?与之对应的英语单词是unique,如果需要就写成:

⑤unique:=true

若不需要呢?就写成:

unique:=false

明白了吧?Excel VBA的魅力就在于当你不明白一些事情的时候,可以通过录制宏来理解,并且是一一对应的.

上面的程序解释到这儿,现在有个问题:如果数据表(理科)发生了变化,或者谁不小心直接运行了这段程序,不就造成结果显示不正确了,怎么办?下面对这段程序进行改进.

要求:当理科工作表中的数据发生变化时,可以在sheet1表中得到体现,使代码变得更加灵活.

实际上就是在每一次运行时,先将原有的筛选结果先清除掉,然后重新进行高级筛选.

Sub 代码改进()
Dim totalR As Integer, totalC As Integer
Worksheets("sheet1").Activate
Range("A4:K65536").Clear
With Sheets("理科").UsedRange
totalR = .Rows.Count '输出89
totalC = .Columns.Count '输出11
End With
Debug.Print totalR
Debug.Print totalC
Sheets("理科").Range("A1:K" & totalR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A4"), Unique:=False
'下一行未通过,提示错误:应用程序定义或对象定义错误!
' Sheets("理科").Range(Cells(1, 1), Cells(totalR, totalC)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A4"), Unique:=False
End Sub

发现问题了:

将错误的一行改为:

Sheets("理科").Range(Sheets("理科").Cells(1, 1), Sheets("理科").Cells(totalR, totalC)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A4"), Unique:=False

或者更简洁的写为:
with Shetts1("理科")

.Range(.Cells(1, 1), .Cells(totalR, totalC)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A4"), Unique:=False
end with

不再解释原因,应该可以看明白了.



今天你菊子曰了么？