本文介绍了在Excel VBA中获取日期自动过滤器的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我试图使用VBA提取Autofilter参数。
任何人可以帮我获取Autofilter参数,特别是在应用日期Autofilter时?
例如假设您有一个包含两列的表,一个包含文本数据,另一个包含日期数据。
将文本过滤器设置为第一个列:

  Range.Autofilter字段:= 1,Criteria1 = Array(text1 ,text2,text3,text4),运算符:= xlFilterValues 

获取过滤器信息,您可以循环通过Criteria1 Variant Array(从1索引)获取每个过滤器,如i = 1到4:

  Print Range.Autofilter.Filters(1).Criteria1(i)

现在第二列表示已设置日期过滤器:

  Range.AutoFilter字段:= 2,运算符:= xlFilterValues,Criteria2:= Array(2,8/10/2015,2,8/20/2015)

如果我们遵循文本过滤器的相同逻辑,我希望我们可以从Criteria2属性中的变量数组获取过滤器信息,但是这个语句会产生错误(1004:应用程序定义或对象定义的错误) ,而您期望整数2作为输出:

  P rint Range.Autofilter.Filters(2).Criteria2(1)


解决方案

我已经走了一个相当长的方法,但它似乎是唯一的方法我可以找到这样做。
通过从xlsx文件中提取xml数据获取过滤器信息,存储在某处,稍后在同一个然后可以通过将xml转换为VBA AutoFilter函数来应用过滤器。工作代码如下:
将自动过滤器解压缩为xml字符串。函数输入是一个表,但可以修改为采取一个范围:

 函数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 - 无法从VBA中提取日期过滤器(Criteria2数组)。从XML中保存过滤器,并解释实现

'XlAutoFilterOperator枚举(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
打开错误Resume Next
tableFilterOn = tbl.AutoFilter.FilterMode
On Error GoTo 0

如果tableFilterOn然后
对于fi = 1 To tbl.AutoFilter.Filters.Count
设置f = tbl.AutoFilter.Filters(fi)
如果f.On然后
hasFilterOn = True
退出
结束如果
下一个

如果hasFilterOn然后
Dim fn As Variant,xmlFn As Variant,zippedFn As Variant,workFolder As Variant,thisGUID As String
thisGUID =GUID
w orkingFolder = Environ(temp)
fn = workingFolder& \&这个GUID& .xlsx.zip
xmlFn =table1.xml
zippedFn =xl\tables\& xmlFn

'保存为temp为xlsx
'Application.Visible = False
Err = 0
错误恢复下一步

ThisWorkbook。 Sheets(Array(_
tbl.Range.Worksheet.Name _
))。复制
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs fn,xlOpenXMLWorkbook
ActiveWorkbook。关闭
Application.DisplayAlerts = True
'Application.Visible = True

如果Err.Number<> 0然后
MsgBox(获取过滤器设置错误)
退出函数
结束如果
错误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

设置objShell = CreateObject(Shell.Application)
设置ns = objShell.Namespace(fn)
'创建对ZIP文件中的文件和文件夹的引用
设置objSource = ns。 Items.Item(zippedFn)
'创建对目标文件夹的引用
设置objTarget = objShell.Namespace(workingFolder)
'UnZIP文件
'选项参考:https:/ /msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v = vs85).aspx
intOptions = 16
objTarget.CopyHere objSource,intOptions
'释放对象
设置objSource = Nothing
设置objTarget = Nothing
设置objShell =没有


'提取过滤器信息
Dim xmlData As String
打开workingFolder& \& xmlFn对于二进制访问读为1
xmlData =空格(LOF(1))
获取1,1,xmlData
关闭1

Dim endTag As Long,startTag As Long
startTag = InStr(1,xmlData,< autoFilter)
如果startTag> 0然后
xmlData = Right(xmlData,Len(xmlData) - startTag + 1)
endTag = InStr(1,xmlData,< / autoFilter>)
xmlData = Left(xmlData ,endTag + Len(< / autoFilter>) - 1)
结束如果

'删除临时文件
错误恢复下一步
杀死fn
Kill workingFolder& \& xmlFn
错误GoTo 0

tmpStr = xmlData

'没有列名称,但稍后我需要这样做,所以添加它们
Dim c As Long
c = 1
对于c = 1 To tbl.AutoFilter.Range.Rows(1).Cells.Count
tmpStr =替换(tmpStr,filterColumn colId = & c - 1&,filterColumn colId =& c - 1&colName =& tbl.HeaderRowRange.Cells(1,c).value& )
下一个
如果
结束If

TableFilterToString = tmpStr结束函数

然后,稍后应用过滤器,将range和xml字符串输入到此函数中。不适应颜色和图标过滤,但如果这成为需求,可以扩展。

  Sub ApplyXmlAutoFilter(autoFilterRange As Range, strXML As String)
'XlAutoFilterOperator枚举(Excel)
'https://msdn.microsoft.com/en-us/library/office/ff839625.aspx

'info日期自动过滤器:
'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
'还有,顶部的sml.xsd里面的zip下载

'清除现有的自动过滤器
autoFilterRange.AutoFilter

如果strXML =then
Exit Sub
End If

Dim objXML As Object
Dim baseNode As Object,filterColNode As对象,filtersNode作为对象,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

设置objXML = CreateObject(MSXML.DOMDocument)

如果不是objXML。 LoadXML(strXML)然后'strXML是带有XML的字符串'
Err.Raise objXML.parseError.ErrorCode,objXML.parseError.reason
End If

'XMLDom ref: https://msdn.microsoft.com/en-us/library/aa468547.aspx

如果objXML.HasChildNodes然后
对于每个baseNode在objXML.ChildNodes
如果baseNode。 HasChildNodes然后
对于每个filterColNode在baseNode.ChildNodes
colId = CLng(filterColNode.getattribute(colId))+ 1'xml是​​0索引,所以增加1
colName = filterColNode.getattribute(colName)
'如果名称存在于该范围内,则使用匹配的名称覆盖colId
matchFound = Application.Match(colName,autoFilterRange.Rows 1),0)
如果不是IsError(matchFound)然后
'只应用过滤器如果找到相同的列
colId = matchFound

'重置过滤器变量
numCriteria1 = 0
numCriteria2 = 0
filterOperator = 0
ReDim criteria1Array(999)
ReDim criteria2Array(999)
criteriaStr =
dynamicFilter = 0

如果filterColNode.HasChildNodes然后
对于每个filtersNode在filterColNode.C hildNodes
如果filtersNode.getattribute(blank)=1则
criteria1Array(numCriteria1)==
numCriteria1 = numCriteria1 + 1
如果

选择案例filtersNode.nodename
案例colorFilter
'将需要从原始XML抓取任何dxfId是
'如果filterDetailNode.getattribute(cellColor)=false 然后
'filterOperator = xlFilterCellColor
'Else
'filterOperator = xlFilterFontColor
'End If
'criteria1Array(numCriteria1 )= filterDetailNode.getattribute(dxfId)
'numCriteria1 = numCriteria1 + 1
案例dynamicFilter
filterOperator = xlFilterDynamic
'val\valISO\maxValIso - 貌似这些属性可以忽略,因为过滤器是动态的...
'不知道null,所以只有已知过滤器的代码
'ref XlDynamicFilterCriteria枚举:https://msdn.microsoft.com/en -us / library / bb241234(v = office.12).aspx
选择案例filtersNode.getattribute(type)
案例null
'dynamicFilter = ???
案例aboveAverage
dynamicFilter = xlFilterAboveAverage
案例belowAverage
dynamicFilter = xlFilterBelowAverage
案例明天
dynamicFilter = xlFilterTomorrow
案例今天
dynamicFilter = xlFilterToday
案例昨天
dynamicFilter = xlFilterYesterday
案例nextWeek
dynamicFilter = xlFilterNextWeek
案例thisWeek
dynamicFilter = xlFilterThisWeek
案例lastWeek
dynamicFilter = xlFilterLastWeek
案例nextMonth
dynamicFilter = xlFilterNextMonth
案例thisMonth
dynamicFilter = xlFilterThisMonth
案例lastMonth
dynamicFilter = xlFilterLastMonth
案例nextQuarter
dynamicFilter = xlFilterNextQuarter
案例thisQuarter
dynamicFilter = xlFilterThisQuarter
caselastQuarter
dynamicFilter = xlFilterLastQuarter
案例nextYear
dynamicFilter = xlFilterNextYear
案例thisYear
dynamicFilter = xlFilterThisYear
案例lastYear
dynamicFilter = xlFilterLastYear
案例yearToDate
dynamicFilter = xlFilterYearToDate
案例Q1
dynamicFilter = xlFilterAllDatesInPeriodQuarter1
案例Q2
dynamicFilter = xlFilterAllDatesInPeriodQuarter2
案例Q3
dynamicFilter = xlFilterAllDatesInPeriodQuarter3
案例Q4
dynamicFilter = xlFilterAllDatesInPeriodQuarter4
案例M1
dynamicFilter = xlFilterAllDatesInPeriodJanuary
案例M2
dynamicFilter = xlFilterAllDatesInPeriodFebruray
案例M3
dynamicFilter = xlFilterAllDatesInPeriodMarch
案例M4
动态过滤器= xlFilterAllDatesInPeriodApril
案例M5
dynamicFilter = xlFilterAllDatesInPeriodMay
案例M6
dynamicFilter = xlFilterAllDatesInPeriodJune
案例M7
dynamicFilter = xlFilterAllDatesInPeriodJuly
案例M8
dynamicFilter = xlFilterAllDatesInPeriodAugust
案例M9
dynamicFilter = xlFilterAllDatesInPeriodSeptember
案例M10
dynamicFilter = xlFilterAllDatesInPeriodOctober
案例M11
dynamicFilter = xlFilterAllDatesInPeriodNovember
案例M12
dynamicFilter = xlFilterAllDatesInPeriodDecember
结束选择

如果dynamicFilter> 0然后
criteria1Array(numCriteria1)= dynamicFilter
numCriteria1 = numCriteria1 + 1
End If
Case Else
对于每个filterDetailNode在filtersNode.ChildNodes
选择案例filterDetailNode.nodename
casefilter
'normal filter
filterOperator = xlFilterValues
criteria1Array(numCriteria1)= filterDetailNode.getattribute(val)
numCriteria1 = numCriteria1 + 1

案例customFilter
选择Case filterDetailNode.getattribute(operator)
案例等于
criteriaStr ==
案例lessThan
criteriaStr =<
案例lessThanOrEqual
criteriaStr =< =
案例notEqual
criteriaStr =<>
案例greaterThanOrEqual
criteriaStr => =
案例greaterThan
criteriaStr =>
Case Else
criteriaStr =
filterOperator = xlAnd
结束选择
criteriaStr = criteriaStr& filterDetailNode.getattribute(val)

如果numCriteria1 = 0然后
criteria1Array(numCriteria1)= criteriaStr
numCriteria1 = numCriteria1 + 1
Else
如果filterDetailNode.getattribute(and)=1然后
filterOperator = xlAnd
Else
filterOperator = xlOr
End If

criteria2Array(numCriteria2) = criteriaStr
numCriteria2 = numCriter ia2 + 1
结束如果

案例dateGroupItem
'日期上的信息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
'始终以美式格式应用字符串,m / d / yyyy或m / d / yyyy H:m:s
filterOperator = xlFilterValues
选择案例filterDetailNode.getattribute(dateTimeGrouping)
案例year
criteria2Array(numCriteria2)= 0
criteria2Array(numCriteria2 + 1)=1/1 /& filterDetailNode.getattribute(year)
numCriteria2 = numCriteria2 + 2
案例month
criteria2Array(numCriteria2)= 1
criteria2Array(numCriteria2 + 1)= filterDetailNode.getattribute 月)& / 1 /& filterDetailNode.getattribute(year)
numCriteria2 = numCriteria2 + 2
案例day
criteria2Array(numCriteria2)= 2
criteria2Array(numCriteria2 + 1)= filterDetailNode.getattribute 月)& /& filterDetailNode.getattribute(day)& /& filterDetailNode.getattribute(year)
numCriteria2 = numCriteria2 + 2
案例小时
criteria2Array(numCriteria2)= 3
criteria2Array(numCriteria2 + 1)= filterDetailNode.getattribute 月)& /& filterDetailNode.getattribute(day)& /& filterDetailNode.getattribute(year)_
& & filterDetailNode.getattribute(hour)& :0:0
numCriteria2 = numCriteria2 + 2
案例分钟
criteria2Array(numCriteria2)= 4
criteria2Array(numCriteria2 + 1)= filterDetailNode.getattribute )& /& filterDetailNode.getattribute(day)& /& filterDetailNode.getattribute(year)_
& & filterDetailNode.getattribute(hour)& :& filterDetailNode.getattribute(minute)& :0
numCriteria2 = numCriteria2 + 2
案例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
结束选择

结束选择
下一个'为每个filterDetailNode在filtersNode.ChildNodes
结束选择

'apply filters
如果filterOperator = xlAnd或filterOperator = xlOr或filterOperator = xlFilterDynamic然后
如果numCriteria2> 0然后
autoFilterRange.AutoFilter _
字段:= colId,_
Criteria1:= criteria1Array(0),_
Criteria2:= criteria2Array(0),_
运算符:= filterOperator
Else
autoFilterRange.AutoFilter _
Field:= colId,_
Criteria1:= criteria1Array(0),_
运算符:= filterOperator
End If
ElseIf numCriteria1> 0和numCriteria2> 0然后
ReDim保留条件1Array(numCriteria1 - 1)
ReDim保留条件2Array(numCriteria2 - 1)
如果filterOperator = 0然后
autoFilterRange.AutoFilter _
字段:= colId,_
Criteria1:= Array(criteria1Array),_
Criteria2:= Array(criteria2Array)
Else
autoFilterRange.AutoFilter _
Field:= colId,_
Criteria1:= Array(criteria1Array),_
Criteria2:= Array(criteria2Array),_
运算符:= filterOperator
End If
ElseIf numCriteria1> 0然后
ReDim Preserve criteria1Array(numCriteria1 - 1)
如果filterOperator = 0然后
autoFilterRange.AutoFilter字段:= colId,Criteria1:= Array(criteria1Array)
Else
autoFilterRange.AutoFilter字段:= colId,Criteria1:= Array(criteria1Array),Operator:= filterOperator
End If
ElseIf numCriteria2> 0然后
ReDim保留条件2Array(numCriteria2 - 1)
如果filterOperator = 0然后
autoFilterRange.AutoFilter字段:= colId,Criteria2:= Array(criteria2Array)
Else
autoFilterRange.AutoFilter字段:= colId,Criteria2:= Array(criteria2Array),Operator:= filterOperator
End If
End If

Next
End If'filterColNode .HasChildNodes
End If'Not IsError(matchFound)
Next'对于每个filterColNode在baseNode.ChildNodes
End If'baseNode.HasChildNodes
Next'对于每个baseNode在objXML.ChildNodes
End If'objXML.HasChildNodes

End Sub

结束


I am trying to extract Autofilter parameters using VBA.Can any one help me with getting the Autofilter parameters, specifically when a date Autofilter is applied?E.g. Say you have a table with two columns, one contains text data, and a second contains date data.
To set text filter to the first colum:

Range.Autofilter Field:=1, Criteria1=Array("text1","text2","text3","text4"), Operator:=xlFilterValues

Then to get the filter information you can loop through the Criteria1 Variant Array (indexed from 1) to get each filter, as in for i = 1 to 4:

Print Range.Autofilter.Filters(1).Criteria1(i)

Now for column two say a date filter has been set:

Range.AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(2, "8/10/2015", 2, "8/20/2015")

If we follow the same logic for the text filter, I'd expect we could get the filter information from a variant array in the Criteria2 property, but this statement will produce an error (1004: Application-defined or object-defined error), whereas you'd expect the integer '2' to be the output:

Print Range.Autofilter.Filters(2).Criteria2(1)
解决方案

I've gone with a rather long-winded approach, but it seems the only way I can find to do it.
Get filter info by extract xml data from xlsx file, store that somewhere, later on the same filter can then be applied by converting the xml into the VBA AutoFilter function. Working code as follows:
Extract autofilter as an xml string. The functions input is a table, but could be modified to take a Range:

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

Then, to later on apply the filter, input the range and xml string into this function. Does not cater to color and icon filtering, but could be expanded if this became a requirement.

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

Ends

这篇关于在Excel VBA中获取日期自动过滤器的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

08-23 21:43