Excel VBA: используйте Поиск, чтобы найти и разместить номер телефона на основе выбранного имени

Question

Я мог бы немного помочь с этим, так как я новичок в Excel VBA. У меня есть двухстраничная книга, и я хотел бы получить помощь по некоторому коду VBA, который помещает номер телефона непосредственно в ячейку ниже, как только имя выбирается из раскрывающегося списка в ячейке выше. Имена, содержащиеся в этом раскрывающемся списке, будут получены от полковника А на первом листе «Контакты», а номера телефонов - из колонки В того же листа контактов. Мой второй лист, «Расписание», представляет собой большой лист планирования, поэтому я хотел бы запускать этот код каждый раз, когда имя выбрано из этого выпадающего списка, независимо от расположения ячейки на этом листе. Любая помощь по этому вопросу будет принята с благодарностью, так как я немного застрял в этом. Еще раз большое спасибо, Randy

Answer 1

Допущения: у вас есть лист с кодовым именем wshContacts. На этом листе у вас есть список имен, и вы назвали этот диапазон "ContactNames". В ячейках рядом с этим диапазоном находятся номера телефонов. На вашем листе расписания в некоторых ячейках есть раскрывающийся список проверки данных, который указывает на именованный диапазон ContactNames.

Исходя из этого, поместите этот код в модуль кода листа расписания (щелкните правой кнопкой мыши вкладку листа и выберите «Просмотреть код»).

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oValid As Validation
    Dim rFind As Range
    Dim sRefersTo As String

    'The named range with your contact names
    Const sCNAMES As String = "ContactNames"

    Set oValid = Target.Validation

    'Trap error where there's no validation in cell
    On Error Resume Next
        sRefersTo = oValid.Formula1
    On Error GoTo 0

    'If it's a DV pointing to contact names
    If sRefersTo = "=" & sCNAMES Then
        'Find the name in the list
        Set rFind = wshContacts.Range(sCNAMES).Find(Target.Value, , xlValues, xlWhole)
        'if the name was found
        If Not rFind Is Nothing Then
            'put the next cell (phone number) in the cell below the changed cell
            Application.EnableEvents = False
                Target.Offset(1, 0).Value = rFind.Offset(0, 1).Value
            Application.EnableEvents = True
        End If
    End If

End Sub

Это будет выполняться для каждого изменения, которое вы вносите в расписание. Но на самом деле он будет действовать только в том случае, если измененная ячейка имеет проверку данных, которая указывает на именованный диапазон на вашем контактном листе.

Есть несколько вещей, на которые стоит обратить внимание. Этот код не предусматривает смену нескольких ячеек, и ему все равно, есть ли что-то в ячейке ниже (он перезаписывает это). Поэтому вам, возможно, придется приспособиться к этим случаям.

Answer 2

Простая формула VLOOKUP сделает это, VBA не требуется.

Если ячейка с раскрывающимся списком - A1, то в A2 эта формула может помочь:

= IF (A1 = "", "", VLOOKUP (A1, Sheet2! $ A: $ B, 2, 0))