如何循环 Vlookup 函数直到结果不为空？

Question

我正在寻找一种方法来重复搜索包含事件的日期表。

用户将选择开始日期和结束日期，我需要知道这些日期是否包含事件。

工作表列出了结束日期和开始日期之间的所有日期。我需要搜索这个数组。
前端视图

搜索区域是工作簿中另一个工作表中的表格，如下所示：
日期表

我希望宏在 A 列中搜索列表中的日期，并在任何日期对应于 E 列中的事件时返回一个 msgbox。

这是我目前所拥有的。我被困在如何将 SearchDate 作为我的 vlookup 的变量范围，以及如何在找到一个结果后停止循环，因为这足以提示警告消息。

Sub EventFinder()
Dim RowNMBR As Long
Dim SearchDate As Range

RowNMBR = 4
Set SearchDate = Cells(4, 12)

With SearchDate
    For Each c In Range("L5:L33")
        On Error Resume Next

        RowNMBR = RowNMBR + 1
        Set SearchDate = Cells(RowNMBR, 12)   

        If Not Application.WorksheetFunction.VLookup(SearchDate, Sheets("Forecast").Range("A:E"), 5, False) = "" _
          Then MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"
        Exit Sub ' and exit procedure
    Next c
    On Error GoTo 0
End With

End Sub

为了添加到宏中，我创建了一个自动宏，以便在“DoA”或“Nights”的值发生变化时调用我的宏。这不能正常工作。

只要我在处理工作表和工作簿，我就解除了保护，但它仍然无法工作。

问题已通过以下代码修复

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim intersection As Range
' Target => you already have an address of changed cell(s)

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("E6")

' Application.Intersect - returns a Range object that represents the
' rectangular intersection of two or more ranges.
Set intersection = Application.Intersect(KeyCells, Target) ' if it intersects that the range will be initialized

If Not (Target.Rows.Count > 1 And Target.Columns.Count > 1) Then    ' check that changed range has only 1 cell
                                                                    ' because if you select a 6th row
                                                                    ' and clear it's contents (or change in any other way) -
                                                                    ' the event will be triggered as well

    If Not intersection Is Nothing Then     ' if the intersection range is initialized
                                            ' then event will be triggered
        Call EventFinder
    End If
End If

Set KeyCells = Range("E9")

' Application.Intersect - returns a Range object that represents the
' rectangular intersection of two or more ranges.
Set intersection = Application.Intersect(KeyCells, Target) ' if it intersects that the range will be initialized

If Not (Target.Rows.Count > 1 And Target.Columns.Count > 1) Then    ' check that changed range has only 1 cell
                                                                    ' because if you select a 6th row
                                                                    ' and clear it's contents (or change in any other way) -
                                                                    ' the event will be triggered as well

    If Not intersection Is Nothing Then     ' if the intersection range is initialized
                                            ' then event will be triggered
        Call EventFinder
    End If
End If

Set KeyCells = Range("E12")

' Application.Intersect - returns a Range object that represents the
' rectangular intersection of two or more ranges.
Set intersection = Application.Intersect(KeyCells, Target) ' if it intersects that the range will be initialized

If Not (Target.Rows.Count > 1 And Target.Columns.Count > 1) Then    ' check that changed range has only 1 cell
                                                                    ' because if you select a 6th row
                                                                    ' and clear it's contents (or change in any other way) -
                                                                    ' the event will be triggered as well

    If Not intersection Is Nothing Then     ' if the intersection range is initialized
                                            ' then event will be triggered
        Call EventFinder
    End If
End If

End Sub

Answer 1

看看这个。阅读 cmets 并且不要忘记将正确的工作表名称放在某些行中。

Sub EventFinder()

Dim shtSource As Worksheet
Dim shtData As Worksheet
Dim SearchDate As Range
Dim searchRange As Range
Dim dataRange As Range
Dim s As Range, d As Range

Set shtSource = ThisWorkbook.Sheets("") ' put proper sheets' names
Set shtData = ThisWorkbook.Sheets("")   ' and here also


Set searchRange = shtData.Range(shtSource.Cells(1, 1), shtSource.Cells(Rows.Count, 1).End(xlUp)) ' set the range of dates to look for each of below in
Set dataRange = shtSource.Range(shtSource.Cells(5, 12), shtSource.Cells(Rows.Count, 12).End(xlUp)) 'set range of dates to look for 


For Each d In dataRange 'take each date from source
    For Each s In searchRange ' check every source date in data range
        If s.Value = d.Value Then ' if dates match
            If Not s.Offset(0, 4) = "" Then ' if event is not empty
                ' show message:
                MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"
                Exit Sub ' and exit procedure
            End If
        End If
    Next
Next
End Sub

更新 1

首先查看我对this post 的回答并修复您的设置。第二件事是我看到你正试图将你的任务分成几个部分并提出不同的问题——这并不总是好的。第三个 - 你最好用列名和行号显示你的“前端视图”，就像第二个屏幕截图一样。

然后，用我的 cmets 检查您的更新代码（最好将其复制到您的 IDE 并在那里查看，并且有更多 cmets 代码:)）

Sub EventFinder()
Dim RowNMBR As Long
Dim SearchDate As Range

RowNMBR = 4     ' you've assigned a row number
                ' that's not the best solution,
                ' as your start row is actually 5
                ' see * comment in the loop regarding this

Set SearchDate = Cells(4, 12)   ' you've assigned a range on active sheet (which one?) to a variable
                                ' BUT see ** comment in the loop

With SearchDate ' useless statement 'cos there's nothing that uses "With" statement below

    For Each c In Range("L5:L33") ' an error should occur here if you read the link and setup properly 'cos you didn't declare the "c" variable
    On Error Resume Next    ' sometimes you can't avoid using this statement, but not this time
                            ' this time it only harms you

    RowNMBR = RowNMBR + 1   ' * it's better to assign the start value at the top as 5, and move this line just before the "Next c"
    Set SearchDate = Cells(RowNMBR, 12) ' ** you re-assign this variable on each loop iteration, so first assignment is useless


        ' Your question why does it always exit the sub. See YOUR block of code:
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If Not Application.WorksheetFunction.VLookup(SearchDate, Sheets("Forecast").Range("A:E"), 5, False) = "" _
        Then MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"
        Exit Sub ' and exit procedure
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' and check out following:
        ' these two lines (your code):
'    If Not Application.WorksheetFunction.VLookup(SearchDate, Sheets("Forecast").Range("A:E"), 5, False) = "" _
'    Then MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"

        ' are the same as this one (you just added a linebreak with the "_" sign ):
'    If Not Application.WorksheetFunction.VLookup(SearchDate, Sheets("Forecast").Range("A:E"), 5, False) = "" Then MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"

        ' so the "Exit Sub" statement is reached everytime,
        ' because if you put it into one line it looks like "If [condition = true] then [do something (just 1 statement) and end of conditional check]"
        ' and Exit statement is not in that If block and performed anyway

        ' the thing you need is below
'    If Not Application.WorksheetFunction.VLookup(SearchDate, Sheets("Forecast").Range("A:E"), 5, False) = "" Then  ' "If [condition = true] then
'        MsgBox "There is an Event on these dates, contact the Revenue Manager!", vbOKOnly, "Event Warning"         ' [do something (first statement)
'        Exit Sub                                                                                                   ' (2d statement)
'                                                                                                                   ' (other statements if needed)
'    End If                                                                                                         ' and end of conditional check]"

    Next c
    On Error GoTo 0
End With

End Sub

更新 2

问题在于 Target 对象使用不当。这是一个range 对象，在Target.Range("E6") 行中，您正试图到达Target 的E6 单元，我希望图片能阐明我的意思：

Target 保存已更改单元格的地址，而不是 Worksheet 的地址，因此，基本上，这就是您所需要的：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' Target => you already have an address of changed cell(s)

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("E6")


If Not (Target.Rows.Count > 1 And Target.Columns.Count > 1) Then    ' check that changed range has only 1 cell
                                                                    ' because if you select a 6th row
                                                                    ' and clear it's contents (or change in any other way) -
                                                                    ' the event will be fired as well

    If Not Application.Intersect(KeyCells, Target) Is Nothing Then  ' and you need to check whether the changed cell is
                                                                    ' the one that will fire an event
        Call EventFinder
    End If
End If
End Sub

Protect/Unprotect 的使用取决于您是否需要更改此特定的受保护工作表，并且不会影响 Call EventFinder，因此如果需要，请使用它。

更新 3

看看这个

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim intersection As Range
' Target => you already have an address of changed cell(s)

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Union(Range("E6"), Range("E9"), Range("E12"))


' Application.Intersect - returns a Range object that represents the
' rectangular intersection of two or more ranges. (c)Excel Help, put cursor on the keyword and press F1
Set intersection = Application.intersect(KeyCells, Target) ' if it intersects that the range will be initialized


If Not (Target.Rows.Count > 1 And Target.Columns.Count > 1) Then    ' check that changed range has only 1 cell
                                                                    ' because if you select a 6th row
                                                                    ' and clear it's contents (or change in any other way) -
                                                                    ' the event will be triggered as well

    If Not intersection Is Nothing Then     ' if the intersection range is initialized
                                            ' then event will be triggered
        Call EventFinder
    End If
End If
End Sub