具有日期条件 returns 空白的自动筛选器

Question

我有下面的代码来过滤一个 sheet 上的数据，另一个 sheet 上的标准。代码似乎有效，但总是 returns 空白，不知道为什么。

有人可以帮忙吗？

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。我想清除此 sheet 单元格 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 sheet 上的 2 个日期列 I 和 AC 以及您的日期来源进行测试是 LNG_PORT_23_SG sheet 上的 A2 和 B2 单元格。这些单元格的格式应为 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 sheet 的愿望，请参阅下面的修改后的代码。

注意选择是否复制带或不带标题的选项 - 只需根据需要取消注释/删除。另外，请不要使用 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 关于需要将过滤结果复制到另一个 sheet 的回应的评论，您可以通过更改

中的以下语句来做到这一点

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

至

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

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

如果 range/table 中确实有中断，那么另一种选择是使用变量来指定数据的最后一行和最后一列。或者如评论中所述，您只需要从单元格 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) 将是 sheet LNG_PORTFOLIO_2023_SG_HIST.[=25= 的最后一列字母和最后一行]

仅供参考，您更新后的代码没有正确粘贴，因此需要重新格式化。但是像这样的东西应该有用。

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

具有日期条件 returns 空白的自动筛选器

Autofilter with date criteria returns blank

variables

excel

vba

date

autofill