#vba #range #target #intersect
#vba #диапазон #цель #пересекать
Вопрос:
Я пытаюсь написать макрос, который отправит электронное письмо, если выбран определенный диапазон и соответствует определенным критериям. У меня есть несколько почтовых отправлений, которые будут вызываться в зависимости от того, какой диапазон выбран / активирован. Я пытаюсь использовать метод Intersect (Range, Target), чтобы ограничить, какой диапазон будет вызывать какой адрес электронной почты. Проблема, с которой я сталкиваюсь, заключается в том, что мой код всегда по умолчанию использует первый диапазон на листе, но мне нужно, чтобы он просто использовал активный диапазон. Я включил пример своего кода ниже.
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
Конец раздела
Комментарии:
1. Все ваши предложения If проверяют одно и то же?
2. Также стоит отметить, что строки в электронной таблице могут меняться по мере добавления и удаления их пользователями. По этой причине я написал код для поиска требуемых диапазонов для запуска вложенных сообщений электронной почты на основе значения ячейки «P», которое я ввел в соответствующий столбец строк, содержащих списки проверки данных для выбора пользователем, которые также используются для запуска вложенных сообщений электронной почты. Это дополнительная сложность, о которой стоит упомянуть.
3. Они проверяют одни и те же значения, которые существуют в разных диапазонах. Диапазон один может содержать только значения «Пройти» или «Завершить», чтобы вызвать соответствующий почтовый подраздел. То же самое для диапазона 2, диапазона 3, до диапазона n.
4. Когда код впервые достигнет
If xRg Is Nothing Then
, он выполнит этот раздел, потому что это true, и пропустит все остальное, поскольку у вас есть предложения ElseIf.5. Могу ли я использовать несколько предложений else и должны ли они быть вложенными? Мне неясно, как еще выполнить то, что необходимо.
Ответ №1:
Выполнение этого немного поспешно, но, надеюсь, вы поняли суть. Должны ли операторы If на самом деле проверять, является ли пересечение НЕ ничем?
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
Комментарии:
1. Это работает, и я должен оценивать «Это не ничто». Я так много раз переписывал этот скрипт, что логика начала немного шататься. Еще раз спасибо.