excel vba 高级过滤

Sub shaixuan()
Dim database As Range '定义数据区域

Dim criteria_range As Range '定义条件区域

Dim extract_field As Range '定义结果区域

Set database = Sheets("man").Range("A1").CurrentRegion ' 数据区域  man 表格A1 据区域中的任何单元格，然后按Ctrl +A选择整个数据区域 空行空列就是CurrentRegion 边界
Set criteria_range = Range("A1", Cells(1, Range("iv1").End(xlToLeft).Column)).CurrentRegion ' 筛选区域，条件区域 当前表格 区域 A1 iv1 数据区域 碰到 空行 空列 不会选中 空行空列就是CurrentRegion 边界

Set extract_field = Range("A16", Cells(16, Range("IV16").End(xlToLeft).Column)) '结果区域
extract_field.CurrentRegion.Offset(1, 0).Clear '清空 旧结果
'
'expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
'数据区域.AdvancedFilter(复制, 条件区域,结果区域, 一条或者多条)
'expression 必需。该表达式返回“应用于”列表中的对象之一。
'Action XlFilterAction 类型，必需。
'XlFilterAction 可为以下 XlFilterAction 常量之一。
'xlFilterCopy
'xlFilterInPlace
'CriteriaRange Variant 类型，可选。条件区域。如果省略本参数，则没有条件限制。
'CopyToRange Variant 类型，可选。如果 Action 为 xlFilterCopy，则本参数指定被复制行的目标区域。否则忽略本参数。
'Unique Variant 类型，可选。如果为 True，则重复出现的记录仅保留一条；如果为 False，则筛选出所有符合条件的记录。默认值为 False。
database.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=criteria_range, CopyToRange:=extract_field, Unique:=False
End Sub

Sub test()
Dim database As Range

Dim criteria_range As Range

Dim extract_field As Range
Set database = Sheets("DataBase").Range("A1").CurrentRegion
Set criteria_range = Range("A1", Cells(1, Range("iv1").End(xlToLeft).Column)).CurrentRegion
Set extract_field = Range("A16", Cells(16, Range("IV16").End(xlToLeft).Column))
extract_field.CurrentRegion.Offset(1, 0).Clear
database.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=criteria_range, CopyToRange:=extract_field, Unique:=False
End Sub

原件下载

百度云下载

扩展学习

对选定的单元格输入设定的内容91

Sub shaixuan()   
    Selection.FormulaR1C1 = "91"  
End Sub

excel vba 高级过滤

推荐阅读