如何获取筛选中类型是日期的内容

FlamesTsui

我有一个表，2个Sheet
两个表数据是对应的，一个是描述，一个是日期。我想实现筛选日期，另外一个表同步筛选。
但是找了很多资料。都毫无头绪。
我设想的方案
获取Sheet2筛选的内容。但是需要问题。
无法获取到日期类型的筛选数据
参考：http://club.excelhome.net/forum. ... =thread&tid=1274662


Sub lqxs()
    Dim r%, Arr1(), i&, j&, n&, Arr2()
    Dim fl As Filter


   'MsgBox AutoFilter.ShowAllData

    With Sheet1
        If .AutoFilterMode Then
            For Each fl In .AutoFilter.Filters
                If fl.On Then
                    r = r + 1
                    ReDim Preserve Arr1(1 To r)
                    'MsgBox fl.Operator
                    'If fl.Operator = Then MsgBox 1
                    'Arr1(r) = fl.Criteria1
                    If fl.Operator = xlFilterValues Then
                        Dim varCriteria2 As Variant
                        With ActiveSheet.AutoFilter.Filters(3)
                          '**********************************************************************
                          'Returns Runtime error 1004 Application defined or object defined error
                          varCriteria2 = .Criteria2
                          '**********************************************************************
                          For i = LBound(varCriteria2) To UBound(varCriteria2)
                            MsgBox varCriteria2(i)
                          Next i
                        End With
                        Arr2() = fl.Criteria2
                    End If
                End If
            Next
        End If
    End With

   'MsgBox AutoFilter.ShowAllData()

    [h:h].ClearContents
    [h22] = "筛选条件": n = 22

    If r = 0 Then MsgBox "没有筛选。": Exit Sub
    For j = 1 To r
        If IsArray(Arr1(j)) Then
            For i = 1 To UBound(Arr1(j))
                n = n + 1
                Cells(n, 8) = Arr1(j)(i)
            Next
        Else
            n = n + 1
            Cells(n, 8) = Arr1(j)
        End If
    Next
End Sub


在获取Criteria2时,就错误1004了。
http://club.excelhome.net/forum. ... 1274662&pid=8667874这个说的
在日期勾选多个值的筛选方式下，Criteria1和Criteria2 都是空，仅有Operator。筛选条件不知道保存在哪里了。
请问，有没有高手知道啊。
发现一篇文章说的是，可以从xml中读取筛选内容。在打开的文件读取本身的xml这简直。。。

获取筛选条件-待补充代码0919.rar (26.23 KB, 下载次数: 0)

2017-4-26 23:04 上传

点击文件名下载附件

要实现的.rar (26.39 KB, 下载次数: 1)

2017-4-26 23:07 上传

点击文件名下载附件

FlamesTsui

我找到一个变通方法。
在Sheet2增加一个按钮之类。双击后
枚举Sheet2显示的内容，在Sheet1显示指定的。
Private Function CheckAutoFilter(ByVal Op As Boolean)
    Dim i As Integer, j As Integer
    Dim LastRow As Integer
    Dim Tmp() As String
   
    If Op = False Then
        Sheets(1).Range("$A$2:$AE$123").AutoFilter 1
    Else
        LastRow = Sheets(ActiveSheet.Index).[A65536].End(xlUp).Row
        
        j = 0
        ReDim Tmp(j)
        
        For i = 3 To LastRow
            If Rows(i).Hidden = False Then
                j = j + 1
                ReDim Preserve Tmp(j)
                Tmp(j) = Cells(i, 1).Value
            End If
        Next
        
        Sheets(1).Range("$A$2:$AE$123").AutoFilter Field:=1, Criteria1:=Array(Tmp), Operator:=xlFilterValues
    End If
End Function