Reset/Reuse 电子表格的目标范围

Question

我正在尝试编写一个宏，如果选择了特定范围并满足特定条件，该宏将发送电子邮件。我有几个电子邮件订阅，将根据 selected/activated 的范围调用它们。我正在尝试使用 Intersect(Range, Target) 方法来限制哪个范围将调用哪个电子邮件子。我遇到的问题是我的代码总是默认为 sheet 中的第一个范围，但我需要它来使用活动范围。我在下面包含了我的代码示例。

Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub

'Checklist Setup Review
Dim LastRow As Long
Dim i As Long
Dim xRg As Range
Dim x As String
Dim NewRng As Range

LastRow = Cells(Rows.Count, "H").End(xlUp).Row
For i = 1 To LastRow
    If UCase(Cells(i, "H").Value) = "P" Then
        If NewRng Is Nothing Then
            Set NewRng = Cells(i, "A")
        Else
            Set NewRng = Union(NewRng, Cells(i, "A"))
        End If
    End If
Next i

'Initial Lidar Review
Dim LastRow1 As Long
Dim e As Long
Dim NewRng1 As Range

LastRow1 = Cells(Rows.Count, "I").End(xlUp).Row
For e = 1 To LastRow1
    If UCase(Cells(e, "I").Value) = "P" Then
        If NewRng1 Is Nothing Then
            Set NewRng1 = Cells(e, "A")
        Else
            Set NewRng1 = Union(NewRng1, Cells(e, "A"))
        End If
    End If
Next e

'Initial Ground Macro Review
Dim LastRow2 As Long
Dim xRg2 As Range
Dim j As Long
Dim NewRng2 As Range

LastRow2 = Cells(Rows.Count, "J").End(xlUp).Row
For j = 1 To LastRow2
    If UCase(Cells(j, "J").Value) = "P" Then
        If NewRng2 Is Nothing Then
            Set NewRng2 = Cells(j, "A")
        Else
            Set NewRng2 = Union(NewRng2, Cells(j, "A"))
        End If
    End If
Next j

'Call Email subs
If xRg Is Nothing Then
    Set xRg = Intersect(NewRng, Target)
    x = True
    For Each r In NewRng
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Project Setup Review Complete: Auto Email Sent."
        Call SetupReview_Email
    End If
ElseIf xRg Is Nothing Then
    Set xRg = Intersect(NewRng1, Target)
    If xRg Is Nothing Then Exit Sub
    x = True
    For Each r In NewRng1
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Intial Lidar Review Completed: Auto Email Sent."
        InitialLidarReview_Email
    End If
ElseIf xRg Is Nothing Then
    Set xRg = Intersect(NewRng2, Target)
    For Each r In NewRng2
        If r.Value <> "Pass" And r.Value <> "Complete" Then
            x = False
        End If
    Next r
    If x = True Then
        MsgBox "Ground Macro Review Completed: Auto Email Sent."
        Call GroundMacro_Email
    End If
End If

结束子

Answer 1

这样做有点仓促，但希望您能理解要点。 If 语句实际上是否应该检查 Intersect 是否 NOT Nothing？

Set xRg = Intersect(NewRng, Target)
If xRg Is Nothing Then
    'stuff
Else
    Set xRg = Intersect(NewRng1, Target)
    If xRg Is Nothing Then
        'stuff
    Else
        Set xRg = Intersect(NewRng2, Target)
        If xRg Is Nothing Then
            'stuff
        End If
    End If
End If

Reset/Reuse 电子表格的目标范围

Reset/Reuse Target Range for Spreadsheet

vba

range

target

intersect