具有日期条件的自动过滤器返回空白

Question

我有下面的代码来过滤一张纸上的数据和另一张纸上的标准。代码似乎可以工作，但总是返回空白，不知道为什么。

有人可以帮忙吗？

Sub data_test_2()
'
' data_test_2 Macro
'


Dim r As Range, filt As Range, d1 As Long, d2 As Long
With Worksheets("LNG_PORT_23_SG")
d1 = .Range("A2").Value
d2 = .Range("B2").Value
With Worksheets("LNG_PORTFOLIO_2023_SG_HIST")
.Range("A1").CurrentRegion.AutoFilter field:=9, Criteria1:=">=" & CDate(d1)

End With
End With
End Sub

更新：我现在使用的代码非常适合过滤位，只是似乎无法复制所有过滤后的数据并粘贴到 LNG_PORT_23_SG。我想清除此工作表上单元格 A11 中的所有现有数据，然后复制并粘贴新的过滤数据。

Option Explicit 
Sub FilterDates() 
Dim date1 As Long, date2 As Long, date3 As Long

date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2 date2 =
Sheets("LNG_PORT_23_SG").Range("B2").Value2 date3 =
Sheets("LNG_PORT_23_SG").Range("E2").Value2

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1") On Error
Resume Next .AutoFilter 28, ">=" & 1 * date1, 7 .AutoFilter 29, "<=" &
1 * date2, 7 .AutoFilter 9, ">=" & 1 * date3, 7 .AutoFilter Field:=1,
Criteria1:=Sheets("LNG_PORT_23_SG").Range("C2").Value, Operator:=xlOr,
Criteria2:=Sheets("LNG_PORT_23_SG").Range("C3").Value
.SpecialCells(xlCellTypeVisible).Copy
Destination:=Sheets("LNG_PORT_23_SG").Range("A11")

End With

On Error GoTo 0

End Sub```

Answer 1

只是对您的代码的一些观察。

如果您打算使用变量，请始终将Option Explicit 放在您的过程顶部——它会强制声明。

不要使用像 d1 或 d2 这样的变量名，因为这很容易与实际的单元格地址混淆。另外，不要声明你从不使用的变量。

以下代码已经过测试，并且基于您在 LNG_PORTFOLIO_2023_SG_HIST 工作表上的 2 个日期列是 I 和 AC，并且您的日期来源是 @ 上的单元格 A2 和 B2 987654329@ 表。这些单元格的格式应为date。

Option Explicit
Sub FilterDates()
Dim date1 As Long, date2 As Long

date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2
date2 = Sheets("LNG_PORT_23_SG").Range("B2").Value2

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")
    .AutoFilter 9, ">=" & 1 * date1, 7
    .AutoFilter 29, "<=" & 1 * date2, 7
End With

End Sub

编辑

根据您对附加条件的最新评论 - 以及将过滤后的数据复制到 LNG_PORT_23_SG 工作表的愿望，请参阅下面的修改后代码。

注意选择是否复制带有或不带有标题的选项 - 只需根据需要取消注释/删除即可。另外，请不要使用On Error Resume Next - 它可以隐藏各种问题...

Option Explicit
Sub FilterDates()
Dim date1 As Long, date2 As Long, date3 As Long, x, y

date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2
date2 = Sheets("LNG_PORT_23_SG").Range("B2").Value2
date3 = Sheets("LNG_PORT_23_SG").Range("E2").Value2
x = Sheets("LNG_PORT_23_SG").Range("C2").Value2
y = Sheets("LNG_PORT_23_SG").Range("C3").Value2

Application.Goto Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1")
With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1").CurrentRegion
    .AutoFilter 1, x, 2, y, 7
    .AutoFilter 28, ">=" & 1 * date1, 7
    .AutoFilter 29, "<=" & 1 * date2, 7
    .AutoFilter 9, ">=" & 1 * date3, 7
    .Copy Sheets("LNG_PORT_23_SG").Range("A11")             '<~~ use this line to copy including headings
    '.Offset(1).Copy Sheets("LNG_PORT_23_SG").Range("A11")  '<~~ OR this line to exclude headings
    .AutoFilter
End With

Application.Goto Sheets("LNG_PORT_23_SG").Range("A1")

End Sub

Answer 2

要从 kevin9999 的回复中回答您关于需要将过滤结果复制到另一个工作表的评论，您可以通过更改以下语句来做到这一点

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1:AC1")

到

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1").CurrentRegion

通过使用.CurrentRegion，它会自动选择与A1 关联的连续单元格范围。您需要确保列标题或空行中没有中断。请注意，将 A1 更改为 A11 不会改变结果，因为它会在上方、左侧、右侧和下方查找任何连续的单元格。

如果您在范围/表格中确实有中断，那么另一种选择是使用变量来指定数据的最后一行和最后一列。 或者按照评论中的要求，您只需从单元格A1 开始，您就可以使用其他方法。 有多种方法可以做到这一点，但我首选的方法是使用Cells.Find() 方法：

RowNum = Sheets("LNG_PORTFOLIO_2023_SG_HIST").Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
ColNum = Sheets("LNG_PORTFOLIO_2023_SG_HIST").Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Column

然后您可以将之前的语句更改为

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range(Cells(1, 11), Cells(RowNum, ColNum))

Cells(1, 11) 与A1 相同，而Cells(RowNum, ColNum) 将是工作表LNG_PORTFOLIO_2023_SG_HIST 中的最后一列字母和最后一行。

仅供参考，您更新的代码未正确粘贴，因此需要重新格式化。但是这样的事情应该可以工作。

Option Explicit
Sub FilterDates()
Dim date1 As Long, date2 As Long, date3 As Long
Dim RowNum As Long, ColNum As Long

'Set header names
date1 = Sheets("LNG_PORT_23_SG").Range("A2").Value2
date2 = Sheets("LNG_PORT_23_SG").Range("B2").Value2
date3 = Sheets("LNG_PORT_23_SG").Range("E2").Value2

With Sheets("LNG_PORTFOLIO_2023_SG_HIST").Range("A1").CurrentRegion
    On Error Resume Next

    'Filter Data
    .AutoFilter 28, ">=" & 1 * date1, 7
    .AutoFilter 29, "<=" & 1 * date2, 7
    .AutoFilter 9, ">=" & 1 * date3, 7
    .AutoFilter Field:=1, Criteria1:=Sheets("LNG_PORT_23_SG").Range("C2").Value, _
        Operator:=xlOr, Criteria2:=Sheets("LNG_PORT_23_SG").Range("C3").Value
    
    'Identify last row and column of range
    RowNum = .Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
    ColNum = .Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Column
    
    'Copy to another sheet
    .Range(Cells(1, 1), Cells(RowNum, ColNum)).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("LNG_PORT_23_SG").Range("A11")
End With

On Error GoTo 0

End Sub