excel - 为什么 VBA 自动过滤器不按大于日期过滤？

Question

我一直在研究我的团队在工作中使用的预订表的功能——创建供应商的预订摘要。我已经完成了大部分工作，UserForm并且InputBox工作完美，但是一旦我将其添加autofilter到表对象的范围中，它只会通过完全匹配过滤，例如Criteria1:="01/04/2021". 尝试使用greater than它时根本不应用过滤器。我做了一些挖掘，发现这可能是到期日期实际上是字符串格式而不是原始日期，我不确定我该如何解决这个问题。

我试图四处走动并将自动过滤器添加到从模板创建的就绪摘要中，但是，每次它都会抛出奇怪的错误，例如object variable or with block not set或for loop not initialised在一秒钟前工作的代码中 - 仅添加的行就在结束之前子CreateSummary：

Template.Sheets(1).ListObjects(1).Range.AutoFilter Filed:=3, Criteria1:=">01/04/2021"

下面的整个代码：

Sub CreateSummary()

    ' start new debugging log
    Debug.Print (vbCrLf & TimeStamp() & ": " & "--- Start" & vbCrLf & vbCrLf)

    ' declare vars
    Dim SearchTerm As String
    Dim SearchDate As Date
    
    Dim Template As Workbook
    Dim Tracker As Workbook
    Dim WS As Worksheet
    Dim i As Long
    Dim Found As Integer
    Dim Today As Date
    Today = Date
    
    Dim CurrentRowCount As Long
    Dim LastRowCount As Long
    Dim FirstEmpty As Long
    
    ' set defaults
    Set Tracker = Application.ThisWorkbook
    SearchDate = Date
    Summary.ClickedAll = Null
    i = 1
    Found = 0
    LastRowCount = 0
    
    ' handle user input
    SearchTerm = InputBox("Please type name of the supplier (it can be just a partial e.g. 'moln' for Molnlycke")
    If SearchTerm = vbNullString Then
        Exit Sub
    ElseIf Len(SearchTerm) < 2 Then
        MsgBox ("The search term have to be minimum 2 characters." & vbCrLf & vbCrLf & "Please run macro again.")
        Exit Sub
    End If
    SummaryOptions.Show

    
    ' Open template file and clear its contents
    Set Template = Workbooks.Open("C:\Users\RJamborski\Desktop\Summary Template.xlsx")
    Set TemplateTable = Template.Sheets(1).ListObjects(1)
        TemplateTable.DataBodyRange.ClearContents
    
    ' loop over all worksheets to find all booking sheets
    For Each WS In Tracker.Worksheets
        If WS.Visible And Not WS.Name = "Matrix" Then ' if worksheet is not visible and not a Matrix
            If InStr(1, WS.Name, "Template", vbTextCompare) = 0 Then ' if worksheet is not a template
                Debug.Print (vbCrLf & TimeStamp() & ": " & "-- Iteration #" & i)
                WS.Activate
                Set WSTable = WS.ListObjects(1)
                ' check if filter is on and clear it
                Call ClearFilters(WS)
                
                ' apply filters
                ' filter by search term in 'supplier' column
                WSTable.Range.AutoFilter Field:=7, Criteria1:="=*" & SearchTerm & "*", Operator:=xlAnd
                ' if option 'All Bookings' has been clicked apply more criteria (filter out cancelled & past bookings)
                If Summary.ClickedAll = False Then
                    With WSTable.Range
                        .AutoFilter Field:=7, Criteria1:="=*" & SearchTerm & "*"
                        .AutoFilter Field:=2, Criteria1:="=ECOM", Operator:=xlOr, Criteria2:="=Planned"
                        
                        ' NEED FIX: on working with string dates
                        .AutoFilter Field:=3, Criteria1:=">" & CDate(4 / 4 / 2021), Operator:=xlAnd
                    End With
                End If

                ' check if DataBodyRange (table's content object) has any height / content found
                On Error GoTo NoCellsFound
                If WSTable.DataBodyRange.Height > 0 Then
                    Debug.Print (TimeStamp() & ": " & "Data found in " & WS.Name)
                    
                   
                    ' set first empty cell reference
                    If Found = 0 Then
                        FirstEmpty = 2
                    ElseIf Found > 0 Then
                        ' fix when there is only one record in template
                        If LastRowCount > 10000 Then
                            FirstEmpty = 2
                        Else
                            FirstEmpty = LastRowCount + 1
                        End If
                    End If
                    Debug.Print (TimeStamp() & ": " & "First Empty = " & FirstEmpty)
                   
                    Found = Found + 1
                   
                    ' select and copy all visble/filtered data
                    WSTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Select
                    Selection.Copy
                    Template.Sheets(1).Activate
                    Template.Sheets(1).Range("A" & FirstEmpty).PasteSpecial Paste:=xlPasteValues, _
                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                                        

                    ' fill in S column with WS.Name value & weekday text value formula in column A
                    CurrentRowCount = GetTotalRows(Template.Sheets(1))
                    Debug.Print (TimeStamp() & ": " & "Current Row Count = " & CurrentRowCount)
                    
                    Debug.Print (TimeStamp() & ": " & "Last Row Count = " & LastRowCount)
                    Debug.Print (TimeStamp() & ": " & "Loop rows " & FirstEmpty & " to " & CurrentRowCount)
                    For n = FirstEmpty To CurrentRowCount
                        Template.Sheets(1).Range("S" & n).Value = WS.Name
                        Template.Sheets(1).Range("A" & n).Formula = "=TEXT(C" & n & ", ""dddd"")"
                    Next n
                       
                    ' update last row count after filling required cells
                    LastRowCount = GetTotalRows(Template.Sheets(1))
                    
                End If ' if DataBodyRange.height > 0

NoCellsFound: ' if no data found in filtered view

                ' update iterator
                i = i + 1
                ' clear filters
                Call ClearFilters(WS)
                
            End If
        End If
    Next WS
    
    ' once complete show top of the template file to the user / reset defaults
    Template.Activate
    ActiveWindow.ScrollRow = 1
    Range("G2").Select
    
    ' for some reason this line breaks the whole loop / WS loop reference looses pointer?
    Template.Sheets(1).ListObjects(1).Range.AutoFilter Filed:=3, Criteria1:=">01/04/2021"
    
    Debug.Print (TimeStamp() & ": " & "End Sub: Found " & LastRowCount - 1 & " records in " & Found & " sites.")
End Sub

Function GetTotalRows(Worksheet)
    Set DBR = Worksheet.ListObjects(1).DataBodyRange
    
    If DBR.Cells(1, "B").End(xlDown).Row > 10000 Then
        GetTotalRows = 2
    Else
        GetTotalRows = DBR.Cells(1, "B").End(xlDown).Row
    End If
End Function

Function ClearFilters(ByRef Worksheet As Worksheet)
    
    Worksheet.Activate
    Range("A1").Select
    
    On Error Resume Next
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Then
        ActiveSheet.ShowAllData
    End If
    
    On Error Resume Next
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.ShowAllData
    End If
    
    On Error Resume Next
    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
End Function

这里有很多Debug.Print电话，因为我一直试图了解宏运行的每一步到底发生了什么。

如果有人知道我该如何解决这个问题，我将不胜感激。几天来我一直在努力克服这个问题，但没有运气。

谢谢！

标签： excelvbadateautofilter

Answer 1

VBA 使用 octothorpes 作为日期值，因此：

Template.Sheets(1).ListObjects(1).Range.AutoFilter Filed:=3, Criteria1:=">#01/04/2021#"