Эффективно Значения Vlookup 400k строк x 10 столбцов - Массивы?

Question

Заранее спасибо за помощь мне в этом. У меня есть набор данных (400 тыс. Строк х 10 столбцов), для которого мне нужно найти значения в другой книге на 5 разных вкладках. Как мне установить это для максимальной эффективности?

Я предполагаю, что я должен использовать массивы, но я пытался поместить наборы данных в массивы и vlookup друг от друга, и это очень медленно .. какие-либо предложения?

Sub KSB1_Macro_Remodeled()

'Declare all variables
    '
    'Numerical
    Dim i As Long

    'Objects - all global

    'Reference File Arrays
    Dim POsWBN As Variant
    Dim WOsWBN As Variant
    Dim MSRMapping As Variant
    Dim FieldMapping As Variant
    Dim GL As Variant
    Dim DocDates As Variant
    Dim MP40 As Variant
    Dim PCMapping As Variant

    'KSB1 Arrays
        'WOs for WO Start Date
        Dim WOsWBT() As Variant
        'CCs for Field, Category, Profit Center, & PC for MSR Field
        Dim CCsWBT() As Variant
        'GL for GL / Budget Category, MSR Category, MSR Subcategory, MBR Category, 6 or 7 digit
        Dim GLWBT() As Variant
        'Activity Date 1 and WO Start Date for Activity Date
        Dim AD1() As Variant
        'POs for Vendor
        Dim POsWBT() As Variant

'Populate WBT and KSB1 Lastrow for BasicCleanUp to run
   Set WBT = ThisWorkbook
        Set WSksb1 = WBT.Sheets("KSB1")
        KSB1LastRow = WSksb1.Cells(Rows.Count, 1).End(xlUp).Row

'Run BasicCleanUp Macro
Call BasicCleanUp


'Populate WBN Arrays
    Workbooks.Open ThisWorkbook.Path & "\ReferenceFiles.xlsx"
    Set WBN = ActiveWorkbook
    '
    POLastRow = WBN.Sheets("PO").Cells(Rows.Count, 1).End(xlUp).Row
    POsWBN = WBN.Sheets("PO").Range("A1:C" & POLastRow)
    '
    WOLastRow = WBN.Sheets("Work Mgmt").Cells(Rows.Count, 1).End(xlUp).Row
    WOsWBN = WBN.Sheets("Work Mgmt").Range("B1:C" & WOLastRow)
    '
    MSRLastRow = WBN.Sheets("MSR Mapping").Cells(Rows.Count, 1).End(xlUp).Row
    MSRMapping = WBN.Sheets("MSR Mapping").Range("A1:D" & MSRLastRow)
    '
    FieldMapLastRow = WBN.Sheets("Field Mapping").Cells(Rows.Count, 1).End(xlUp).Row
    FieldMapping = WBN.Sheets("Field Mapping").Range("A1:C" & FieldMapLastRow)
    '
    GLLastRow = WBN.Sheets("GL").Cells(Rows.Count, 1).End(xlUp).Row
    GL = WBN.Sheets("GL").Range("A1:C" & GLLastRow)
    '
    DocDatesLastRow = WBN.Sheets("Dates & Categories").Cells(Rows.Count, 1).End(xlUp).Row
    DocDates = WBN.Sheets("Dates & Categories").Range("D1:E" & DocDatesLastRow)
    '
    MP40LastRow = WBN.Sheets("MP40").Cells(Rows.Count, 1).End(xlUp).Row
    MP40 = WBN.Sheets("MP40").Range("A1:K" & MP40LastRow)
    '
    PCMapLastRow = WBN.Sheets("PC Mapping").Cells(Rows.Count, 1).End(xlUp).Row
    PCMapping = WBN.Sheets("PC Mapping").Range("A1:B" & PCMapLastRow)


'Populate WBT Arrays
    '
    ReDim WOsWBT(KSB1LastRow, 2) As Variant
    WOsWBT(1, 1) = WSksb1.Range("W2:W" & KSB1LastRow)

    'Tests Array PrintOut - 'WBT.Sheets("Sheet2").Range("A1:A" & KSB1LastRow) = WOsWBT(1, 1)
    '
    ReDim CCsWBT(KSB1LastRow, 5) As Variant
    CCsWBT(1, 1) = WSksb1.Range("B2:B" & KSB1LastRow)
    '
    ReDim GLWBT(KSB1LastRow, 6) As Variant
    GLWBT(1, 1) = WSksb1.Range("D2:D" & KSB1LastRow)
    '
    ReDim AD1(KSB1LastRow, 3) As Variant
    AD1(1, 1) = WSksb1.Range("R2:R" & KSB1LastRow)
    '
    ReDim POsWBT(KSB1LastRow, 2) As Variant
    POsWBT(1, 1) = WSksb1.Range("G2:G" & KSB1LastRow)
    '

For i = 1 To KSB1LastRow
    'WOs for WO Start Date
    WOsWBT(i, 2) = Application.WorksheetFunction.VLookup(WOsWBT(i, 1), WOsWBN, 2, False)

    'CCs for Field, Category, Profit Center, & PC for MSR Field
    'CCsWBT(i, 2)=

    'GL for GL / Budget Category, MSR Category, MSR Subcategory, MBR Category, 6 or 7 digit
    'GLWBT(i, 2)=

    'Activity Date 1 and WO Start Date for Activity Date
    'AD1(i, 2) =

    'POs for Vendor
    'POsWBT(i, 2)=

Loop

WBT.Sheets("Sheet2").Range("A1:A" & KSB1LastRow) = WOsWBT(1, 2)