VBA – 使用searchfunction在两个date之间设置范围

我试图让我的VBA代码search一个用户input值（在窗体上）的列，并根据这些值设置范围。

我需要代码通过列向下扫描，直到find值（这是一个date），然后通过列向上扫描以获得范围的第二部分。 我需要它是这样的，因为可能有多个同一date的实例，他们都需要考虑。

我试过这个：

StartRange = ws.Cells.Find(What:=StartDate, SearchOrder:=xlRows, _ SearchDirection:=xlNext, LookIn:=xlValues) EndRange = ws.Cells.Find(What:=EndDate, SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues) 

但是，这不是我所期望的，也是错误的。 （编辑：WS已被定义，所以我知道这不是问题）。 我甚至不知道我是否以正确的方式进行

我感觉失败:(

任何帮助将不胜感激，提前致谢！

编辑：

我还没有尝试任何的build议，因为我现在离开了我的项目，但我觉得我需要澄清一些事情。

1. date将始终按照时间顺序，我有一个脚本，组织他们在表激活

2. 我需要能够处理date，不会出现在数据库中，我也需要脚本能够“跳过”不存在的date。 即第一，第一，第三，第三，第五。 如果我的开始和结束date是第一和第五，那么整个例子就是范围。

感谢您的帮助到目前为止，家伙，虽然，我感谢！

EDIT2：

我已经尝试了一些答案，并将其添加到我的代码中，但现在在Range_Global失败时失败。

 Dim startrange, endrange, searchrange As Range LookUpColumn = 2 With ws.Columns(LookUpColumn) Set startrange = .Find(What:=Me.R_Start.Value, _ After:=ws.Cells(.Rows.count, LookUpColumn), _ SearchOrder:=xlRows, _ SearchDirection:=xlNext, LookIn:=xlValues) Set endrange = .Find(What:=Me.R_End.Value, _ After:=ws.Cells(5, LookUpColumn), _ SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues) searchrange = Range(startrange, endrange) MsgBox searchrange.Address End With 

有什么build议么？

Answer 1

让我们从这个开始，看看需要什么调整。 这段代码会查找一个date（基于input）并在列中查找该date的位置 。 与“EndDate”相同，然后在两个位置之间的该列上创build一个范围 。

 Sub ARange() Dim Sh As Worksheet: Set Sh = Sheets("Sheet1") Dim i, j As Integer LookupColumn = "A" 'Define the LookupColum / If you find using column index to be simpler then you need to switch the search from (range) to (cells) StartDate_Value = Sh.Range("B2").Value 'Use whatever you need to define the input values EndDate_Value = Sh.Range("C2").Value 'Use whatever you need to define the input values For i = 1 To 30000 If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i Next i For j = EndDate_Row To 1 Step -1 If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j Next j Dim MyDateRange As Range: Set MyDateRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row) MsgBox "MyDateRange = " & LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row End Sub 

另一种方法应该是从下往上（如Excel的列值）和StartDate从上到下查找EndDate。 喜欢这个：

 For i = 30000 to 1 step -1 For j = 1 To 30000 

第三个（魅力）：从上到下的EndDate和从上到下的StartDate。 喜欢这个：

 For i = 1 to 30000 For j = 1 To 30000 

而第四（一）：

 For i = 1 to 30000 For j = 30000 to 1 Step -1 

在我的家庭笔记本电脑上，30.000个单元格的search是即时的（不到1秒）。 试一试，根据反馈我们可以微调它。

另一方面，我可能会阅读你的问题，看看如果要select顶部/底部位置之间的所有值，但任何单元格与2个input值之间的date值neverminind列表中的值的排列（列单元格） 。 即如果StartDate = 1.Jan.2013和EndDate = 3.Jan.2013。 代码应该从30.000列表中选取1,2和3，从而不会明确这3个date的位置（实际上可能会发现数千次）。 如果这是真的，解决scheme可能比上面的更简单。

Answer 2

使用Find是做这种事情的正确方法，你只需要得到一些细节。

• 使用Set来分配范围参考。 例如Set StartRange = ... （并确保Dim StartRange as Range ）。 同上EndRange和SearchRange

• 指定一个After单元格。 请注意，默认情况下，这是search范围的左上angular单元格，search开始于此单元格之后。 如果您的StartDate碰巧位于单元格A1（和另一个单元格）中，则默认情况下将返回错误的结果

• 将search范围限制在感兴趣的列中。

• Dim所有的variables。 每个variables都需要自己的As （并使用Option Explicit ）

最终结果

 Dim startrange As Range, endrange As Range, searchrange As Range Dim LookUpColumn as Long LookUpColumn = 2 With ws.Columns(LookupColumn) ' Make sure lookup column data is type Date Set searchrange = .SpecialCells(xlCellTypeConstants) searchrange.Value = searchrange .Value Set searchrange = Nothing Set StartRange = .Find(What:=CDate(StartDate), _ After:=.Cells(.Rows.Count, LookupColumn), _ SearchOrder:=xlRows, _ SearchDirection:=xlNext, LookIn:=xlValues) Set EndRange = .Find(What:=CDate(EndDate), _ After:=.Cells(1, LookupColumn), _ SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues) End With Set searchrange = Range(startrange, endrange) MsgBox searchrange.Address 

Answer 3

我不喜欢这个datesearch的概念，有几个原因。

• 它假定date总是按顺序
• 它假设这两个date将存在于列表中

虽然在这种情况下这些可能是有效的假设，但我相信可能有些情况下可能不是这种情况…

我不知道这样做的最好方法，但一个替代考虑是使用自动filter

就像是：

  Sub FindDateRange() Dim sht As Worksheet Dim column As Long Set sht = Sheet1 Dim rng As Range, inclusiveRange As Range Dim startDate As Long, endDate As Long column = 2 On Error GoTo Err startDate = DateValue("02/10/2012") endDate = DateValue("05/10/2012") Application.Calculation = xlCalculationManual Application.ScreenUpdating = False sht.Cells(1, column).AutoFilter Field:=column, Criteria1:=">=" & startDate, Operator:=xlAnd _ , Criteria2:="<=" & endDate Set rng = sht.Range(sht.Cells(2, column), sht.Cells(sht.Cells(sht.Rows.Count, column).End(xlUp).Row, column)).SpecialCells(xlCellTypeVisible) sht.AutoFilterMode = False If rng.Address = sht.Cells(1, column).Address Then MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _ & vbCrLf & vbCrLf & "No instances of the date range exist" Else Set inclusiveRange = sht.Range(rng.Cells(1, 1), rng.Cells(rng.Count, 1)) MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _ & vbCrLf & vbCrLf & "the range is " & rng.Address & vbCrLf & vbCrLf & _ "inclusive range is " & inclusiveRange.Address End If continue: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Exit Sub Err: MsgBox Err.Description GoTo continue End Sub