Excel VBA：从用户输入中查找日期范围

Question

所以我有一个包含多张工作表的工作簿，每张工作表中的每一行用于不同的产品，并且有产品到达的日期以及其他一些信息。

我有一张名为“GRN-Date Search”的表格，允许用户在其中输入特定信息并通过 VBA 搜索表格并复制和粘贴信息。

不过，在让它搜索用户定义的日期范围时，我遇到了困难。

这是我想给你一个想法的约会。我是 VBA 新手，所以我不确定是否可以将 .find 函数用于日期范围？

如果您能提供任何帮助，我们将不胜感激。

Sub DateSearch_Click()

    If Range("B3") = "" Then
        MsgBox "You must enter a date to search"
        Range("B3").Select
        Exit Sub
    Else
        'Clear "GRN-Date Search" Sheet Row  through End
            Sheets("GRN-Date Search").Range("A7:A" & Rows.Count).EntireRow.Clear
        'Set myDate variable to value in B3
            myDate = Sheets("GRN-Date Search").Range("B3")
        'Set initial Paste Row
            nxtRw = 7
        'Loop through Sheets 2 - 29
            For shtNum = 2 To 29
        'Search Column b for date(s)
            With Sheets(shtNum).Columns(1)
             Set d = .Find(myDate)
                If Not d Is Nothing Then
                    firstAddress = d.Address
                Do
        'Copy each Row where date is found to next empty Row on Summary sheet
                d.EntireRow.Copy Sheets("GRN-Date Search").Range("A" & nxtRw)
                nxtRw = nxtRw + 1
                Set d = .FindNext(d)
            Loop While Not d Is Nothing And d.Address <> firstAddress
                 End If
        End With
    Next

    End If

End Sub

Answer 1

要使用日期范围，您需要放弃使用 .Find。最好的方法是使用自动过滤。以下代码使用此功能并假设您的用户在单元格B3 和C3 中输入日期范围。还记得autofilter 认为您在过滤范围内有一个标题行。

Sub DateSearch_Click()
    Dim date1 As Date, date2 As Date, nxtRw As Long, shtNum As Long
    ' Date Range entered in cells B3 and C3
    If Range("B3") = "" Or Range("C3") = "" Then
        MsgBox "You must enter a date to search"
        Range("B3").Select
        Exit Sub
    End If
    date1 = Sheets("GRN-Date Search").Range("B3")
    date2 = Sheets("GRN-Date Search").Range("C3")

    'Clear "GRN-Date Search" Sheet Row  through End
    Sheets("GRN-Date Search").Range("A7:A" & Rows.count).EntireRow.Clear
    nxtRw = 7   'Set initial Paste Row
    For shtNum = 2 To 29 'Loop through Sheets 2 - 29
      With Sheets(shtNum).Range("A5:A" & Sheets(shtNum).Cells(Rows.Count, 1).End(xlUp).Row)
        .AutoFilter Field:=1, Operator:=xlAnd, Criteria1:=">=" & date1, Criteria2:="<=" & date2
        .Offset(1).EntireRow.Copy Sheets("GRN-Date Search").Range("A" & nxtRw)
        nxtRw = nxtRw + .SpecialCells(xlCellTypeVisible).Count - 1
        .AutoFilter
      End With
    Next
End Sub