Vlookup с другого листа и вставьте результат в другой лист

Question

Мне нужна помощь с vlookup с использованием vba, так как я не смог найти решение в Интернете Ситуация у меня три листа

• Лист 1: Значение поиска в ячейке B3 с именем
  Лист 1

• Лист 2: Таблица поиска со столбцом name и surname
  Лист 2

• Лист 3: Результат поиска в ячейке B3 с surname
  Лист 3

Вы можете обратиться к изображениям для лучшего понимания

Таким образом, значение на листе 1 является моим поисковым значением, а фамилия должна быть напечатана на листе 3, а массив таблиц - на листе 2

Код, который я пробовал:

Sub nameloopkup()
    Dim name As String
    Dim result As String
    Dim myrange As Range

    name = Worksheets("Sheet1").Range("B3").Value

    myrange = Worksheets("Sheet2").Range("A:B").Value
    result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)
    ' the query does not run and i don't know how can i print the result in sheet 3
End sub

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

Любая помощь или предложение приветствуется.

Answer 1

myrange = Worksheets("Sheet2").Range("A:B").Value
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)

Вот ваша ошибка. Второй аргумент Vlookup - это Range, а не String. Поскольку диапазон - это объект, вам также необходимо Set it:

Set myrange = Worksheets("Sheet2").Range("A:B")
result = Application.WorksheetFunction.VLookup(name, myrange, 2, False)

Answer 2

На самом деле все, что вам нужно сделать, это:

Sub nameloopkup()
    Dim Name As String
    Dim Result As String
    Dim SearchIn As Variant 'variant to use it as array

    Name = Worksheets("Sheet1").Range("B3").Value
    SearchIn = Worksheets("Sheet2").Range("A:B").Value 'read data into array

    On Error Resume Next 'next line errors if nothing was found
    Result = Application.WorksheetFunction.VLookup(Name, SearchIn, 2, False)
    On Error Goto 0

    If Result <> vbNullString Then
        Worksheets("Sheet3").Range("B3").Value = Result
    Else
        MsgBox "Nothing found"
    End If
End Sub

Либо просто напишите формулу:

Sub NameLookUpFormula()
    Worksheets("Sheet3").Range("B3").Formula = "=VLOOKUP(Sheet1!B3,Sheet2!A:B,2,FALSE)"
End Sub

Answer 3

Вот то, что вы могли бы 2 ... Есть 2 варианта, если вам нужен только один ввод данных или если вам нужен целый массив данных и каждый раз выбирает из него то, что вам нужно:

Option Explicit
Sub nameloopkup()

    Dim C As Range, LastRow As Long, EmptyRow As Long, i As Long, arrData
    Dim DictData As New Scripting.Dictionary 'You need to check Microsoft Scripting Runtime from references for this
    Dim wsNames As Worksheet, wsTable As Worksheet, wsSurnames As Worksheet

    'First thing, reference all your sheets
    With ThisWorkbook
        Set wsNames = .Sheets("Sheet1") 'change this as needed
        Set wsTable = .Sheets("Sheet2")
        Set wsSurnames = .Sheets("Sheet3")
    End With

    'Keep all the data in one dictionary:
    With wsTable
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'last row on Sheet2
        i = .Cells(1, .Columns.Count).End(xlToLeft).Column 'last column on Sheet2            
        arrData = .Range(.Cells(1, 1), .Cells(LastRow, i)).Value 'keep the data on the array

        'This will throw an error if there are duplicates
        For i = 2 To UBound(arrData)
            DictData.Add arrData(i, 1), i 'keep tracking of every name's position ' also change for arrData(i, 2) if you only need the surname
        Next i
    End With

    With wsNames
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row 'last row on Sheet1
        For Each C In .Range("B3:B" & LastRow)
            EmptyRow = wsSurnames.Cells(wsSurnames.Rows.Count, 1).End(xlUp).Row
            wsSurnames.Cells(EmptyRow, 2) = DictData(C.Value) 'if you used arrData(i, 2) instead i
            wsSurnames.Cells(EmptyRow, 2) = arrData(DictData(C.Value), 2) 'If you used i
        Next C
    End With

End Sub