Как написать Если ячейка в диапазоне имеет значение EMAIL, отправьте электронное письмо на эти значения

Question

У меня есть 3 столбца («O», «Q», «S»), которые используют VLOOKUP для получения адреса электронной почты от ввода имен людей.Я хочу, чтобы все эти люди получили одно электронное письмо с некоторыми подробностями.Я не хочу, чтобы этот код выполнялся, если в любом из 3 столбцов нет значений электронной почты.Я хотел бы, чтобы код выполнялся, если ЛЮБОЙ из 3-х столбцов имеет адрес электронной почты внутри него ...

У меня есть этот код для проверки, содержит ли ячейка адрес электронной почты, а затем отправка этого адреса электронной почты по электронной почте.НО мне это нужно для ВСЕХ 3 ячеек, и мне нужно, чтобы они были отправлены по электронной почте вместе.

If emailbox.Value = True Then

On Error Resume Next
i = ActiveCell.Row                  'VLOOKUP
Sheet2.Cells(i, 15).Value = Application.WorksheetFunction.VLookup(Sheet2.Cells(i, 14).Value, Sheet3.Range("AMS"), 2, 0)

On Error Resume Next
i = ActiveCell.Row                  'VLOOKUP
Sheet2.Cells(i, 17).Value = Application.WorksheetFunction.VLookup(Sheet2.Cells(i, 16).Value, Sheet3.Range("AQE"), 2, 0)


Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

        For Each cell In Sheet2.Range("O" & ActiveCell.Row)
        If cell.Value Like "?*@?*.?*" Then 'Check cell for email address

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = cell.Value
                .Subject = "SUBJECT"
                .Body = "Dear...."



                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing

            sent.Visible = True
            Else
        End If
   Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End If

Answer 1

Выполните цикл по каждой ячейке в column O и протестируйте все три ячейки на наличие электронного письма, при обнаружении электронного письма он выполнит оставшуюся часть кода и выйдет из внутреннего цикла.

Dim cel As Range, lRow As Long, x As Long
lRow = ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row

    For Each cel In Range("O2:O" & lRow)
        For x = 15 To 19 Step 2 'loop through each cell in the active row

            If Cells(cel.Row, x).Value Like "?*@?*.?*" Then
                'email .To = Cells(cel.Row, x).Value
                Exit For 'exits the inner loop when the condition is met
            End If

        Next x

    Next cel