有效地 Vlookup 值 400k 行 x 10 列 - 数组？

Question

提前感谢您帮助我。我有一个数据集（400k 行 x 10 列），我需要在另一个工作簿的 5 个不同选项卡中查找值。我应该如何设置才能获得最高效率？

我猜我应该使用数组，但我尝试将数据集放入数组并相互查找，但速度非常慢。有什么建议吗？

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)