Excel VBA AutoFilter双日期筛选无结果，手动筛选正常

我编写了一个Excel宏，用于打开CSV格式的工作簿并对第10列应用日期范围筛选，但运行后未返回任何行；手动在该工作簿执行相同筛选却能得到结果。

相关筛选代码片段：

msoWb.Activate
With ActiveSheet.Range("A:Z")
    .AutoFilter Field:=10, Criteria1:=">=" & dtFrom, Operator:=xlAnd, Criteria2:="<=" & dtTo
End With

其中dtFrom和dtTo是Double类型，存储日期的整数形式。奇怪的是，仅使用单个日期相等条件（AutoFilter Field:=10, Criteria1:=dtFrom）筛选时可正常运行，但一应用双条件范围筛选就无结果。

完整宏代码如下：

Sub ImportData()
Dim msoWb As Workbook
Dim fullFileName As String
Dim newTabName As String
Dim rng As Range
Dim strDtFrom As Variant
Dim dtFrom As Double
Dim strDtTo As Variant
Dim dtTo As Double
Dim feesWorksheet As Worksheet
Dim newWorksheet As Worksheet
Dim feesRange As Range
Dim valRange As Range
Dim cell As Range
Dim propertyValue As Variant
Dim valuationType As Variant
Dim matchRow As Variant
Dim custResultValue As Variant
Dim atomResultValue As Variant
Dim row As Range
Dim feeColumnCustomer As Integer
Dim feeColumnAtom As Integer

strDtFrom = InputBox("Enter FROM date:", "Date", Format(Now, "dd/mm/yyyy"))

If IsDate(strDtFrom) Then
    dtFrom = CDbl(CDate(strDtFrom))
Else
    MsgBox "Invalid FROM date! Re-run the Macro."
    Exit Sub
End If

strDtTo = InputBox("Enter TO date:", "Date", Format(Now, "dd/mm/yyyy"))

If IsDate(strDtTo) Then
    dtTo = CDbl(CDate(strDtTo))
    If dtTo < dtFrom Then
        MsgBox "TO date cannot be less than FROM date! Re-run the Macro."
        Exit Sub
    End If
Else
    MsgBox "Invalid TO date! Re-run the Macro."
    Exit Sub
End If

fullFileName = Application.GetOpenFilename("CSV Files (*.csv),*.csv")

If fullFileName = "" Or fullFileName = "False" Then
    MsgBox ("No file selected. Re-run the Macro.")
    Exit Sub
End If

Set thisWb = ThisWorkbook

newTabName = Format(Now, "dd.mm.yy hh.MM.ss")

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = Workbooks.Add
wb.Activate
wb.Sheets("Sheet1").Name = newTabName

Set msoWb = Workbooks.Open(fullFileName)
msoWb.Activate


With ActiveSheet.Range("A:Z")
    .AutoFilter Field:=10, Criteria1:=">=" & dtFrom, Operator:=xlAnd, Criteria2:="<=" & dtTo
End With

Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeVisible)
wb.Activate
rng.Copy wb.Worksheets(newTabName).Range("A1")

msoWb.Close SaveChanges:=False
wb.Activate

Range("B1").EntireColumn.Insert
Cells(1, 2).Value = "Customer Amount £"
Range("C1").EntireColumn.Insert
Cells(1, 3).Value = "Atom Amount £"
Cells(1, 19).Value = "Valuation Type"
Columns("B:Z").HorizontalAlignment = xlRight
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Range("E:F,H:I,K:K,M:O,Q:Q").EntireColumn.Hidden = True

Set feesWorksheet = ThisWorkbook.Worksheets("Fee Rates")
Set newWorksheet = ActiveSheet
Set feesRange = feesWorksheet.Range("A1:N1000")

Set valRange = newWorksheet.Range("A2:T" & newWorksheet.Cells(newWorksheet.Rows.Count, "G").End(xlUp).row)

For Each row In valRange.Rows
    For Each cell In row.Cells
        If cell.column = 7 Then
            propertyValue = cell.Value
        ElseIf cell.column = 19 Then
            valuationType = cell.Value
        End If
    Next cell
    
    feeColumnCustomer = 0
    feeColumnAtom = 0
    
    Select Case valuationType
        Case "Basic valuation"
            feeColumnCustomer = 4
            feeColumnAtom = 3
        Case "Homebuyer Survey"
            feeColumnCustomer = 6
            feeColumnAtom = 5
        Case "Building Survey"
            feeColumnCustomer = 8
            feeColumnAtom = 7
        Case "Re-type"
            feeColumnCustomer = 10
            feeColumnAtom = 9
        Case "Re-inspection"
            feeColumnCustomer = 12
            feeColumnAtom = 11
    End Select
    
    matchRow = Application.WorksheetFunction.Match(propertyValue, feesRange.Columns(1), 1)
    
    If feeColumnCustomer = 0 Then
        custResultValue = "Unknown"
    Else
        custResultValue = Application.WorksheetFunction.Index(feesRange.Columns(feeColumnCustomer), matchRow)
    End If
    
    Cells(row.row, 2).Value = custResultValue
    
    If feeColumnAtom = 0 Then
        atomResultValue = "Unknown"
    Else
        atomResultValue = Application.WorksheetFunction.Index(feesRange.Columns(feeColumnAtom), matchRow)
    End If
    
    Cells(row.row, 3).Value = atomResultValue
    
    newWorksheet.Range("B2:C" & newWorksheet.Cells(newWorksheet.Rows.Count, "C").End(xlUp).row).Interior.ColorIndex = 37
Next row

valRange.Sort Key1:=Range("L1"), Order1:=xlAscending

Application.ScreenUpdating = True
End Sub

问题原因 #

核心问题出在CSV文件的日期列格式与VBA筛选条件的匹配上：

1. CSV文件打开后，Excel可能未自动将第10列识别为日期格式，而是文本格式。此时用Double类型的日期值拼接成">=" & dtFrom的字符串条件，无法与文本格式的日期匹配。
2. 单个相等条件生效是因为Criteria1:=dtFrom时，VBA会自动尝试将数值转换为适配单元格格式的条件，但范围筛选的字符串拼接方式无法完成这种自动转换。

解决方案 #

提供两种可行的修复方式：

方式1：先转换CSV日期列格式

打开CSV文件后，先将第10列转为日期格式再筛选：

Set msoWb = Workbooks.Open(fullFileName)
msoWb.Activate
' 将第10列转为日期格式并刷新值
ActiveSheet.Columns(10).NumberFormat = "dd/mm/yyyy"
ActiveSheet.Columns(10).Value = ActiveSheet.Columns(10).Value

With ActiveSheet.Range("A:Z")
    .AutoFilter Field:=10, Criteria1:=">=" & dtFrom, Operator:=xlAnd, Criteria2:="<=" & dtTo
End With

方式2：使用日期字符串拼接条件

将dtFrom和dtTo转换为Excel可识别的日期字符串，再拼接筛选条件：

With ActiveSheet.Range("A:Z")
    .AutoFilter Field:=10, Criteria1:=">=" & Format(dtFrom, "dd/mm/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(dtTo, "dd/mm/yyyy")
End With

额外优化建议

尽量避免使用Activate和ActiveSheet，直接通过对象引用操作，减少上下文切换错误：

Set msoWb = Workbooks.Open(fullFileName)
With msoWb.ActiveSheet.Range("A:Z")
    .AutoFilter Field:=10, Criteria1:=">=" & Format(dtFrom, "dd/mm/yyyy"), Operator:=xlAnd, Criteria2:="<=" & Format(dtTo, "dd/mm/yyyy")
End With

内容的提问来源于stack exchange，提问作者templegate