VBA-код для поиска значения в диапазоне и возврата ячейки по значению

Question

Я надеюсь, что кто-нибудь может помочь мне с строкой кода, которую я не могу понять. Кодирование VBA - не моя сильная сторона. Рабочая книга, из которой получен этот код, автоматически отправит по электронной почте адреса в столбце М. Затем она извлекает данные из других ячеек в этой строке, которые используются в строке темы и теле. Где у меня возникла проблема - это значение, которое будет в столбце H строки. То значение, которое будет в этой ячейке, является идентификатором пользователя. Этот идентификатор пользователя можно найти в диапазоне («A2: A18») рабочего листа «Пользователи». Адрес электронной почты пользователя, значение которого я ищу, находится в диапазоне («B2: B18») того же листа. Выдержка из приведенного ниже кода, к которому это относится: «Пожалуйста, отправьте свои распечатанные документы по электронной почте:» & Cells (cell.Row, «H»). Значение »

Любая помощь очень ценится.

Private Sub CommandButton1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String

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

On Error GoTo cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "A").Value) = "yes" _
       And LCase(Cells(cell.Row, "A").Value) <> "Sent" Then

        Set OutMail = OutApp.CreateItem(0)

        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = Cells(cell.Row, "AD").Value
            .Body = "Dear " & Cells(cell.Row, "AC").Value & "," & vbNewLine & vbNewLine & strbody & _
            "Your closeout package for " & Cells(cell.Row, "C").Value & "/" & Cells(cell.Row, "D").Value & "/" & Cells(cell.Row, "E").Value & "/" & Cells(cell.Row, "F").Value & " is over 30 days past due." & vbNewLine & _
            "All closeout requirements are attached for your reference and due within 10 days of construction complete. Please email your closeout documents to: " & Cells(cell.Row, "H").Value & _
            "• Scheduled Construction Start Date - " & Cells(cell.Row, "X").Value & vbNewLine & _
            "• Construction Start Date - " & Cells(cell.Row, "V").Value & vbNewLine & _
            "• Construction Completed Date- " & Cells(cell.Row, "W").Value & vbNewLine & vbNewLine & _
            "• General Contractor - " & Cells(cell.Row, "N").Value & vbNewLine & _
            "• GC Name - " & Cells(cell.Row, "O").Value & vbNewLine & _
            "• GC Phone Number - " & Cells(cell.Row, "P").Value & vbNewLine & _
            "• GC Email - " & Cells(cell.Row, "Q").Value & vbNewLine & vbNewLine & _
            "• Company - " & Cells(cell.Row, "J").Value & vbNewLine & _
            "• Name - " & Cells(cell.Row, "K").Value & vbNewLine & _
            "• Phone Number - " & Cells(cell.Row, "L").Value & vbNewLine & _
            "• Email - " & Cells(cell.Row, "M").Value & vbNewLine & vbNewLine

            .Send
        End With
        On Error GoTo 0
        Cells(cell.Row, "A").Value = "Sent"
        Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

Возможно, используйте Application.Vlookup для поиска адреса электронной почты на основе идентификатора, что-то вроде следующего:

Set OutMail = OutApp.CreateItem(0)

Dim emailTo As Variant
emailTo = Application.Vlookup(Cells(cell.Row, "H").Value, Sheets("Users").Range("A2:B18"), 2, False)

... "Please email your closeout documents to: " & emailTo ...

Обратите внимание, что Application.Vlookup вернет значение ошибки, если vlookup неуспешен, так что вы можете проверить результат, используя IsError(emailTo).