Valores Effeciently Vlookup 400k linhas x 10 colunas - Arrays?

Question

Agradeço antecipadamente por me ajudar com isso. Eu tenho um conjunto de dados (400k linhas x 10 colunas) que eu preciso procurar valores para em outra pasta de trabalho em 5 guias diferentes. Como devo configurar isso para máxima eficiência?

Eu estou supondo que eu deveria usar matrizes, mas eu tentei colocar os conjuntos de dados em matrizes e vlookup uns dos outros e é extremamente lento .. alguma sugestão?

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)