Vlookup из другой рабочей книги (результат также в другой рабочей книге)

Question

Мне нужно написать код для выполнения vlookup в столбце H в рабочей книге 1, сопоставление - из столбца A отдельной рабочей книги, а результатом является столбец B для другой рабочей книги. Не знаю, как это сделать может кто-нибудь, пожалуйста, помогите

Sub y()

Dim rw As Long, x As Range, v As Variant
Dim extwbk As Workbook, twb As Workbook
Dim wsActiveSheet As Worksheet

Columns("H").Insert
    Range("H1") = "1st phase"

Set wsActiveSheet = Application.ActiveSheet
Set extwbk = Workbooks.Open("C:\Users\OUROBOROS\Desktop\Goldratt\24-6-19\1st phase stores.xlsx") 'file with reference table
Set x = extwbk.Worksheets("Sheet1").Range("A2:A300")

For rw = 2 To wsActiveSheet.Cells(Rows.Count, "G").End(xlUp).Row
    v = Application.Match(wsActiveSheet.Cells(rw, "G").Value, x, 0)
    If IsNumeric(v) Then
        wsActiveSheet.Cells(rw, "H").Value = extwbk.Worksheets("Sheet1").Cells(rw, "b").Value 'G is in the table
    Else
        wsActiveSheet.Cells(rw, "H").Value = "NA" ''G is NOT in the table
    End If
Next rw


    Dim LR As Long
Range("a1").EntireRow.Insert
    LR = Range("v" & Rows.Count).End(xlUp).Row
    Range("v1").Formula = "=SUBTOTAL(9,v3:v" & LR & ")"

    LR = Range("v" & Rows.Count).End(xlUp).Row
    Range("w1").Formula = "=SUBTOTAL(9,w3:w" & LR & ")"

    LR = Range("v" & Rows.Count).End(xlUp).Row
    Range("x1").Formula = "=SUBTOTAL(9,x3:x" & LR & ")"

    LR = Range("v" & Rows.Count).End(xlUp).Row
    Range("y1").Formula = "=SUBTOTAL(9,y3:y" & LR & ")"
End Sub

Answer 1

Я не уверен, что это будет именно то, что вам действительно нужно, потому что вы задали несколько столбцов по вашему вопросу, а в вашем коде есть совершенно другие.Вы можете изменить столбцы, изменив соответствующие им номера arr (i, X) X - номер столбца.

Option Explicit
Sub y()

    Dim arrSource, arrLookUp
    Dim DictData As New Scripting.Dictionary 'Needs the Microsoft Scripting Runtime 'Tools->References
    Dim i As Long
    Dim extwbk As Workbook


    With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name(the one were you are doing the vlookup)
        .Columns("H").Insert
        .Range("H1") = "1st phase"
        arrSource = .UsedRange.Value 'store the whole sheet inside the array
    End With

    Set extwbk = Workbooks.Open("C:\Users\OUROBOROS\Desktop\Goldratt\24-6-19\1st phase stores.xlsx") 'file with reference table
    With extwbk.Sheets("MyOtherSheet") 'Change MyItherSheet for the name of the sheet holding the reference table
        arrLookUp = .UsedRange.Value 'store the whole sheet inside the array
    End With
    extwbk.Close SaveChanges:=False 'close the file with the reference table (the data is already in the array)

    'Create a dictionary holding the index for the lookup
    For i = 2 To UBound(arrLookUp) 'loop through the reference table
        If Not DictData.Exists(arrLookUp(i, 1)) Then 'check if the value in column A is not  duplicated
            DictData.Add arrLookUp(i, 1), arrLookUp(i, 2) 'add the matching value from column A with it's value in column B
        End If
    Next i

    'Loop through your original table to find the matches
    For i = 2 To UBound(arrSource)
        If Not DictData.Exists(arrSource(i, 7)) Then 'check if we have a match inside the dictionary for column G
            arrSource(i, 8) = "NA" 'if column G value is not found in the dictionary, column H will have a "NA"
        Else
            arrSource(i, 8) = DictData(arrSource(i, 7)) 'if column G value is found in the dictionary, column H will have column B from the other workbook
        End If
    Next i

    Dim LR As Long
    With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name(the one were you are doing the vlookup)
        .UsedRange.Value = arrSource 'drop back the array into the sheet
        .Range("a1").EntireRow.Insert
        LR = Range("v" & .Rows.Count).End(xlUp).Row
        .Range("v1").Formula = "=SUBTOTAL(9,v3:v" & LR & ")"

        LR = .Range("v" & .Rows.Count).End(xlUp).Row
        .Range("w1").Formula = "=SUBTOTAL(9,w3:w" & LR & ")"

        LR = .Range("v" & .Rows.Count).End(xlUp).Row
        .Range("x1").Formula = "=SUBTOTAL(9,x3:x" & LR & ")"

        LR = .Range("v" & .Rows.Count).End(xlUp).Row
        .Range("y1").Formula = "=SUBTOTAL(9,y3:y" & LR & ")"
    End With

End Sub