我正在尝试使用VBA提取Autofilter参数。
任何人都可以帮助我获取自动过滤器参数，特别是在应用日期自动过滤器时？
例如。假设您有一个包含两列的表，一列包含文本数据，另一列包含日期数据。
要将文本过滤器设置为第一个列：
Range.Autofilter Field:=1, Criteria1=Array("text1","text2","text3","text4"), Operator:=xlFilterValues
然后，要获取过滤器信息，您可以遍历Criteria1变体数组（从1索引）以获取每个过滤器，如i = 1到4：
Print Range.Autofilter.Filters(1).Criteria1(i)
现在第二列说已经设置了日期过滤器：
Range.AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(2, "8/10/2015", 2, "8/20/2015")
如果我们遵循文本过滤器的相同逻辑，我希望我们可以从Criteria2属性中的变量数组中获取过滤器信息，但是此语句将产生错误（1004：应用程序定义的或对象 - 定义错误），而你期望整数＆＃39; 2＆＃39;成为输出：
Print Range.Autofilter.Filters(2).Criteria2(1)
答案 0 :(得分：2)
我已经走了一个相当冗长的方法，但它似乎是我能找到的唯一方法。
通过从xlsx文件中提取xml数据获取过滤器信息，存储在某处，稍后然后可以通过将xml转换为VBA AutoFilter函数来应用相同的过滤器。工作代码如下：
将自动筛选器提取为xml字符串。函数输入是一个表，但可以修改为采用范围：
Function TableFilterToString(tbl As ListObject) As String
Dim tmpStr As String, f As Filter, i As Long, fi As Long
Dim hasFilterOn As Boolean, tableFilterOn As Boolean
'bleh - cannot extract date filters from VBA (Criteria2 array). Save filters from XML instead, and interpret on implementation
'XlAutoFilterOperator Enumeration (Excel)
'https://msdn.microsoft.com/en-us/library/office/ff839625.aspx
'info on date autofilters:
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1
tmpStr = ""
fi = 1
Err.Number = 0
On Error Resume Next
tableFilterOn = tbl.AutoFilter.FilterMode
On Error GoTo 0
If tableFilterOn Then
For fi = 1 To tbl.AutoFilter.Filters.Count
Set f = tbl.AutoFilter.Filters(fi)
If f.On Then
hasFilterOn = True
Exit For
End If
Next
If hasFilterOn Then
Dim fn As Variant, xmlFn As Variant, zippedFn As Variant, workingFolder As Variant, thisGUID As String
thisGUID = "GUID"
workingFolder = Environ("temp")
fn = workingFolder & "\" & thisGUID & ".xlsx.zip"
xmlFn = "table1.xml"
zippedFn = "xl\tables\" & xmlFn
'save to temp as xlsx
'Application.Visible = False
Err = 0
On Error Resume Next
ThisWorkbook.Sheets(Array( _
tbl.Range.Worksheet.Name _
)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs fn, xlOpenXMLWorkbook
ActiveWorkbook.Close
Application.DisplayAlerts = True
'Application.Visible = True
If Err.Number <> 0 Then
MsgBox ("Error getting filter settings")
Exit Function
End If
On Error GoTo 0
'extract table1.xml
'http://stackoverflow.com/questions/19716587/how-to-open-a-file-from-an-archive-in-vba-without-unzipping-the-archive
'http://www.rondebruin.nl/win/s7/win002.htm
Dim intOptions As Variant, objShell As Object, objSource As Object, objTarget As Object
Dim ns As Object
Set objShell = CreateObject("Shell.Application")
Set ns = objShell.Namespace(fn)
' Create a reference to the files and folders in the ZIP file
Set objSource = ns.Items.Item(zippedFn)
' Create a reference to the target folder
Set objTarget = objShell.Namespace(workingFolder)
' UnZIP the files
'options ref: https://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
intOptions = 16
objTarget.CopyHere objSource, intOptions
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
'extract filter info
Dim xmlData As String
Open workingFolder & "\" & xmlFn For Binary Access Read As 1
xmlData = Space(LOF(1))
Get 1, 1, xmlData
Close 1
Dim endTag As Long, startTag As Long
startTag = InStr(1, xmlData, "<autoFilter")
If startTag > 0 Then
xmlData = Right(xmlData, Len(xmlData) - startTag + 1)
endTag = InStr(1, xmlData, "</autoFilter>")
xmlData = Left(xmlData, endTag + Len("</autoFilter>") - 1)
End If
'delete temp files
On Error Resume Next
Kill fn
Kill workingFolder & "\" & xmlFn
On Error GoTo 0
tmpStr = xmlData
'dont have column names, but I will need this later, so add them in.
Dim c As Long
c = 1
For c = 1 To tbl.AutoFilter.Range.Rows(1).Cells.Count
tmpStr = Replace(tmpStr, "filterColumn colId=""" & c - 1 & """", "filterColumn colId=""" & c - 1 & """ colName=""" & tbl.HeaderRowRange.Cells(1, c).value & """")
Next
End If
End If
TableFilterToString = tmpStr End Function
然后，要稍后应用过滤器，请将range和xml字符串输入到此函数中。不满足颜色和图标过滤，但如果需要，可以扩展。
Sub ApplyXmlAutoFilter(autoFilterRange As Range, strXML As String)
'XlAutoFilterOperator Enumeration (Excel)
'https://msdn.microsoft.com/en-us/library/office/ff839625.aspx
'info on date autofilters:
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1
'refs on autofilter xml schema
'http://www.ecma-international.org/publications/standards/Ecma-376.htm
'autofilters: part1 p.3859
'also, top of sml.xsd inside the zip download
'clear existing autofilter
autoFilterRange.AutoFilter
If strXML = "" Then
Exit Sub
End If
Dim objXML As Object
Dim baseNode As Object, filterColNode As Object, filtersNode As Object, filterDetailNode As Object
Dim matchFound As Variant
Dim colId As Long, colName As String, filterOperator As Integer, dynamicFilter As Integer
Dim criteria1Array() As Variant, criteria2Array() As Variant, numCriteria1 As Long, numCriteria2 As Long
Dim criteriaStr As String
Set objXML = CreateObject("MSXML.DOMDocument")
If Not objXML.LoadXML(strXML) Then 'strXML is the string with XML'
Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
End If
'XMLDom ref: https://msdn.microsoft.com/en-us/library/aa468547.aspx
If objXML.HasChildNodes Then
For Each baseNode In objXML.ChildNodes
If baseNode.HasChildNodes Then
For Each filterColNode In baseNode.ChildNodes
colId = CLng(filterColNode.getattribute("colId")) + 1 'xml is 0-indexed, so increase by 1
colName = filterColNode.getattribute("colName")
'if the name exists in the range, then overwrite the colId with the matching name
matchFound = Application.Match(colName, autoFilterRange.Rows(1), 0)
If Not IsError(matchFound) Then
'only apply filter if same column is found
colId = matchFound
'reset filter variables
numCriteria1 = 0
numCriteria2 = 0
filterOperator = 0
ReDim criteria1Array(999)
ReDim criteria2Array(999)
criteriaStr = ""
dynamicFilter = 0
If filterColNode.HasChildNodes Then
For Each filtersNode In filterColNode.ChildNodes
If filtersNode.getattribute("blank") = "1" Then
criteria1Array(numCriteria1) = "="
numCriteria1 = numCriteria1 + 1
End If
Select Case filtersNode.nodename
Case "colorFilter"
'will need to extrapolate from original XML grab what dxfId is
' If filterDetailNode.getattribute("cellColor") = "false" Then
' filterOperator = xlFilterCellColor
' Else
' filterOperator = xlFilterFontColor
' End If
' criteria1Array(numCriteria1) = filterDetailNode.getattribute("dxfId")
' numCriteria1 = numCriteria1 + 1
Case "dynamicFilter"
filterOperator = xlFilterDynamic
'val\valISO\maxValIso - seemingly these attributes can be ignored, as the filter is dynamic anyway...
'not sure about null, so only code for known filters
'ref XlDynamicFilterCriteria enumeration: https://msdn.microsoft.com/en-us/library/bb241234(v=office.12).aspx
Select Case filtersNode.getattribute("type")
Case "null"
'dynamicFilter = ???
Case "aboveAverage"
dynamicFilter = xlFilterAboveAverage
Case "belowAverage"
dynamicFilter = xlFilterBelowAverage
Case "tomorrow"
dynamicFilter = xlFilterTomorrow
Case "today"
dynamicFilter = xlFilterToday
Case "yesterday"
dynamicFilter = xlFilterYesterday
Case "nextWeek"
dynamicFilter = xlFilterNextWeek
Case "thisWeek"
dynamicFilter = xlFilterThisWeek
Case "lastWeek"
dynamicFilter = xlFilterLastWeek
Case "nextMonth"
dynamicFilter = xlFilterNextMonth
Case "thisMonth"
dynamicFilter = xlFilterThisMonth
Case "lastMonth"
dynamicFilter = xlFilterLastMonth
Case "nextQuarter"
dynamicFilter = xlFilterNextQuarter
Case "thisQuarter"
dynamicFilter = xlFilterThisQuarter
Case "lastQuarter"
dynamicFilter = xlFilterLastQuarter
Case "nextYear"
dynamicFilter = xlFilterNextYear
Case "thisYear"
dynamicFilter = xlFilterThisYear
Case "lastYear"
dynamicFilter = xlFilterLastYear
Case "yearToDate"
dynamicFilter = xlFilterYearToDate
Case "Q1"
dynamicFilter = xlFilterAllDatesInPeriodQuarter1
Case "Q2"
dynamicFilter = xlFilterAllDatesInPeriodQuarter2
Case "Q3"
dynamicFilter = xlFilterAllDatesInPeriodQuarter3
Case "Q4"
dynamicFilter = xlFilterAllDatesInPeriodQuarter4
Case "M1"
dynamicFilter = xlFilterAllDatesInPeriodJanuary
Case "M2"
dynamicFilter = xlFilterAllDatesInPeriodFebruray
Case "M3"
dynamicFilter = xlFilterAllDatesInPeriodMarch
Case "M4"
dynamicFilter = xlFilterAllDatesInPeriodApril
Case "M5"
dynamicFilter = xlFilterAllDatesInPeriodMay
Case "M6"
dynamicFilter = xlFilterAllDatesInPeriodJune
Case "M7"
dynamicFilter = xlFilterAllDatesInPeriodJuly
Case "M8"
dynamicFilter = xlFilterAllDatesInPeriodAugust
Case "M9"
dynamicFilter = xlFilterAllDatesInPeriodSeptember
Case "M10"
dynamicFilter = xlFilterAllDatesInPeriodOctober
Case "M11"
dynamicFilter = xlFilterAllDatesInPeriodNovember
Case "M12"
dynamicFilter = xlFilterAllDatesInPeriodDecember
End Select
If dynamicFilter > 0 Then
criteria1Array(numCriteria1) = dynamicFilter
numCriteria1 = numCriteria1 + 1
End If
Case Else
For Each filterDetailNode In filtersNode.ChildNodes
Select Case filterDetailNode.nodename
Case "filter"
'normal filter
filterOperator = xlFilterValues
criteria1Array(numCriteria1) = filterDetailNode.getattribute("val")
numCriteria1 = numCriteria1 + 1
Case "customFilter"
Select Case filterDetailNode.getattribute("operator")
Case "equal"
criteriaStr = "="
Case "lessThan"
criteriaStr = "<"
Case "lessThanOrEqual"
criteriaStr = "<="
Case "notEqual"
criteriaStr = "<>"
Case "greaterThanOrEqual"
criteriaStr = ">="
Case "greaterThan"
criteriaStr = ">"
Case Else
criteriaStr = ""
filterOperator = xlAnd
End Select
criteriaStr = criteriaStr & filterDetailNode.getattribute("val")
If numCriteria1 = 0 Then
criteria1Array(numCriteria1) = criteriaStr
numCriteria1 = numCriteria1 + 1
Else
If filterDetailNode.getattribute("and") = "1" Then
filterOperator = xlAnd
Else
filterOperator = xlOr
End If
criteria2Array(numCriteria2) = criteriaStr
numCriteria2 = numCriteria2 + 1
End If
Case "dateGroupItem"
'info on date autofilters:
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1
'always apply string in American formats, either m/d/yyyy or m/d/yyyy H:m:s
filterOperator = xlFilterValues
Select Case filterDetailNode.getattribute("dateTimeGrouping")
Case "year"
criteria2Array(numCriteria2) = 0
criteria2Array(numCriteria2 + 1) = "1/1/" & filterDetailNode.getattribute("year")
numCriteria2 = numCriteria2 + 2
Case "month"
criteria2Array(numCriteria2) = 1
criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/1/" & filterDetailNode.getattribute("year")
numCriteria2 = numCriteria2 + 2
Case "day"
criteria2Array(numCriteria2) = 2
criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year")
numCriteria2 = numCriteria2 + 2
Case "hour"
criteria2Array(numCriteria2) = 3
criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
& " " & filterDetailNode.getattribute("hour") & ":0:0"
numCriteria2 = numCriteria2 + 2
Case "minute"
criteria2Array(numCriteria2) = 4
criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
& " " & filterDetailNode.getattribute("hour") & ":" & filterDetailNode.getattribute("minute") & ":0"
numCriteria2 = numCriteria2 + 2
Case "second"
criteria2Array(numCriteria2) = 5
criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
& " " & filterDetailNode.getattribute("hour") & ":" & filterDetailNode.getattribute("minute") & ":" & filterDetailNode.getattribute("second")
numCriteria2 = numCriteria2 + 2
End Select
End Select
Next 'For Each filterDetailNode In filtersNode.ChildNodes
End Select
'apply filters
If filterOperator = xlAnd Or filterOperator = xlOr Or filterOperator = xlFilterDynamic Then
If numCriteria2 > 0 Then
autoFilterRange.AutoFilter _
Field:=colId, _
Criteria1:=criteria1Array(0), _
Criteria2:=criteria2Array(0), _
Operator:=filterOperator
Else
autoFilterRange.AutoFilter _
Field:=colId, _
Criteria1:=criteria1Array(0), _
Operator:=filterOperator
End If
ElseIf numCriteria1 > 0 And numCriteria2 > 0 Then
ReDim Preserve criteria1Array(numCriteria1 - 1)
ReDim Preserve criteria2Array(numCriteria2 - 1)
If filterOperator = 0 Then
autoFilterRange.AutoFilter _
Field:=colId, _
Criteria1:=Array(criteria1Array), _
Criteria2:=Array(criteria2Array)
Else
autoFilterRange.AutoFilter _
Field:=colId, _
Criteria1:=Array(criteria1Array), _
Criteria2:=Array(criteria2Array), _
Operator:=filterOperator
End If
ElseIf numCriteria1 > 0 Then
ReDim Preserve criteria1Array(numCriteria1 - 1)
If filterOperator = 0 Then
autoFilterRange.AutoFilter Field:=colId, Criteria1:=Array(criteria1Array)
Else
autoFilterRange.AutoFilter Field:=colId, Criteria1:=Array(criteria1Array), Operator:=filterOperator
End If
ElseIf numCriteria2 > 0 Then
ReDim Preserve criteria2Array(numCriteria2 - 1)
If filterOperator = 0 Then
autoFilterRange.AutoFilter Field:=colId, Criteria2:=Array(criteria2Array)
Else
autoFilterRange.AutoFilter Field:=colId, Criteria2:=Array(criteria2Array), Operator:=filterOperator
End If
End If
Next
End If 'filterColNode.HasChildNodes
End If 'Not IsError(matchFound)
Next 'For Each filterColNode In baseNode.ChildNodes
End If 'baseNode.HasChildNodes
Next 'For Each baseNode In objXML.ChildNodes
End If 'objXML.HasChildNodes
End Sub
完
答案 1 :(得分：0)
我认为你原来的问题是双重的。
首先，您似乎在没有impl AsRef<str> for RequestUri {
#[inline]
fn as_ref(&self) -> &str {
match self {
&RequestUri::AbsoluteUri(ref url) => url.serialize().as_ref()
}
}
}
的情况下使用Criteria2字段。您只想在创建复合条件时使用Criteria1，这需要Criteria2参数和Criteria1参数组合（例如XLAutoFilterOperator或xlAnd）使用xlOr参数。在您的示例中，您似乎没有指定Criteria2参数。
其次，IIRC所有标准必须以字符串形式提供 - 我相信你的第二个例子会导致你试图通过的数字出现问题。
我很惊讶您实际上并未在Criteria1行上收到错误消息。
尝试将代码更改为：
Autofilter答案 2 :(得分：0)
在过滤器选择器中使用树视图时会出现此问题。
在this post中解释了在这种情况下恢复自动过滤器的工作方法。