[英]Excel Advanced Filter Very slow to run, but only after autofilter has been run
[英]Apply advanced filter after autofilter
我想做两次连续过滤; 第一个在我使用自动过滤器的日期和生成的结果我想做进行过滤(因为我记住了OR)。 所以我首先要做的是将范围变量设置为未过滤范围。
Set rng = Range(ws.Cells(1, 1), ws.Cells(rowNos, colNos))
然后使用自动过滤器I过滤给定日期。
rng.AutoFilter Field:=1, Criteria1:=">" & lDate
从现在开始会隐藏一些行,而我想应用高级过滤器,我使用了specialcells
rng.SpecialCells(xlCellTypeVisible).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=crt, CopyToRange:=thisWB.Worksheets("Sheet3").Range("A1"), _
Unique:=False
但是我在最后一步得到了一个错误“命令需要至少两行数据。”我确保至少有100行符合标准,这意味着错误不是因为缺少行。
请帮我解决问题。 此外,如果有另一种方式我可以完成任务,我将很乐意改变我的代码。 我要做的是针对特定日期过滤表格,然后再次过滤两列上的值(通常使用高级过滤器完成)。
似乎.AdvancedFilter
不适用于非连续范围。 下面的代码有点像kludge-y,但是我在一个小例子中工作,我想要返回的结果是> 2014年4月1日,其中Foo = Yes和Bar = 7.我的数据表只包含一行匹配所有这些标准。
Option Explicit
Sub FilterTwice()
Dim DataSheet As Worksheet, TargetSheet As Worksheet, _
ControlSheet As Worksheet, TempSheet As Worksheet
Dim DataRng As Range, ControlRng As Range, _
TempRng As Range
Dim lDate As Date
Dim LastRow As Long, LastCol As Long
'assign sheets for easy reference
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
Set ControlSheet = ThisWorkbook.Worksheets("Sheet2")
Set TargetSheet = ThisWorkbook.Worksheets("Sheet3")
'clear any previously-set filters
Call ClearAllFilters(DataSheet)
'assign data range
LastRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set DataRng = Range(DataSheet.Cells(1, 1), DataSheet.Cells(LastRow, LastCol))
'assign a control (or critieria) range for the advanced filter
Set ControlRng = Range(ControlSheet.Cells(1, 1), ControlSheet.Cells(2, 2))
'apply date filter
lDate = "4/1/2014"
With DataRng
.AutoFilter Field:=1, Criteria1:=">" & lDate
End With
'add a temporary sheet and copy the visible cells to create a continuous range
Set TempSheet = Worksheets.Add
DataRng.SpecialCells(xlCellTypeVisible).Copy
TempSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
'assign temp range
LastRow = TempSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = TempSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set TempRng = Range(TempSheet.Cells(1, 1), TempSheet.Cells(LastRow, LastCol))
'apply advanced filter to temp range and get obs where foo = yes and bar = 7
With TempRng
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ControlRng, _
CopyToRange:=TargetSheet.Range("A1"), Unique:=False
End With
'remove the temp sheet and clear filters on the data sheet
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = True
DataSheet.AutoFilterMode = False
End Sub
Sub ClearAllFilters(cafSheet As Worksheet)
With cafSheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.