Сброс / повторное использование целевого диапазона для электронной таблицы

ProgramBox

Сброс / повторное использование целевого диапазона для электронной таблицы

Post author:admin
Запись опубликована:3 апреля, 2023
Post category:Вопросы по программированию

#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