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

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

1 个答案: