VLookup Macro в Excel

Question

У меня есть книга Excel с двумя рабочими листами. Рабочий лист A имеет несколько имен в нем с каждым именем в другом столбце, а рабочий лист B содержит те же имена, что и на листе A, и второй столбец, содержащий даты. Пример:

Worksheet A.  Worksheet B. 

Name.    Name.  Dates 
Sean    Jake  11/13/15 
Jake    Sean  10/11/14 
Tom.    Chris  12/12/15 

То, что я пытаюсь сделать, это установить макрос, который вызывает ВПР и передает имя из столбца имен в Рабочем листе А в качестве параметра поиска на Рабочем листе B. раз имя находится на Рабочем листе B , он возвращает дату. В настоящее время я вручную имея эти данные, запряженных жесткого кодирования следующего ВПР в колонке на Рабочем листе А.

=VLOOKUP(A2,'Worksheet B'!A:B,2,FALSE) 

Любые предложения и помощь очень ценится.

спасибо.

Answer 1

Вы можете использовать функции листа в VBA. Этот макрос использует их, возвращая значения, которые они обнаруживают, в соответствующие ячейки.

Sub auto_VLOOKUP() 
    Dim rw As Long, wsB As Worksheet 
    Set wsB = Worksheets("Worksheet B") 
    With Worksheets("Worksheet A") 
     For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 
      If CBool(Application.CountIf(wsB.Columns(1), .Cells(rw, 1).Value)) Then 
       ' VLOOKUP is typically used to return data from the right of the lookup column 
       .Cells(rw, 2) = Application.VLookup(.Cells(rw, 1).Value, wsB.Columns("A:B"), 2, False) 
       ' INDEX/MATCH function pairs are used to wider scope 
       .Cells(rw, 3) = Application.Index(wsB.Columns("N"), Application.Match(.Cells(rw, 1).Value, wsB.Columns("A"), 0)) 
      End If 
     Next rw 
     .Cells(2, 2).Resize(rw - 2, 1).NumberFormat = "m/d/yyyy" 
    End With 
    Set wsB = Nothing 
End Sub 

Вам придется изменить имена листов и настроить столбцы, которые не являются такими же, как те, что вы, представленных в данных образцов.

Answer 2

Это не vlookup, но он получит нужные результаты.

Sub Button1_Click() 
    Dim ws As Worksheet, sh As Worksheet 
    Dim Rws As Long, Rng As Range 
    Dim c As Range, FndC As Range, shRng As Range 


    Set ws = Sheets("Sheet1") 
    Set sh = Sheets("Sheet2") 
    Set shRng = sh.Range("A:A").SpecialCells(xlCellTypeConstants, 23) 
    With ws 
     Rws = .Cells(Rows.Count, "A").End(xlUp).Row 
     Set Rng = .Range(.Cells(1, 1), .Cells(Rws, 1)) 
    End With 
    For Each c In Rng.Cells 

     Set FndC = shRng.Find(what:=c, lookat:=xlWhole) 

     If Not FndC Is Nothing Then 
      c.Offset(0, 1) = FndC.Offset(0, 1) 
     Else: c.Offset(0, 1) = "Not Found" 
      Exit Sub 
     End If 
    Next c 
End Sub