Excel VBA：从用户input中查找date范围

所以我有一个工作簿，多个工作表，每个工作表中的每一行都是针对不同的产品，并且有一个产品到达的date以及其他一些信息。

我有一张名为“GRN-Date Search”的工作表，我允许用户input特定信息，并通过工作表searchVBA并复制和粘贴信息。

尽pipe如此，当我想要search用户定义的date范围时，我已经遇到了困难。

这是我有一个约会给你一个想法。 我是VBA的新手，所以我不确定在date范围内是否可以使用.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

要使用date范围，您需要放弃使用.Find 。 最好的方法是使用自动过滤。 下面的代码使用此function，并假定您的用户在单元格B3和C3inputdate范围。 另请注意， 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