VBA Vlookup with Scripting Dictionary

Question

2つ目のワークシートは、300k +のエントリを持つ2番目のシート（Sheet2S）でvlookupする必要がある40k +（Sheet1S）のエントリを持つ最初のワークシートです。

私はこのスクリプトを使って、forループを10行に調整した場合に動作するスクリプトdictonaryに基づいてvlookupを実行しました（私は実際のforループをコメント解除しました）。私はすべての行を使用している場合しかし、それは年齢を取る：

Sub aTest() 
    Dim a As Variant, i As Long 
    With CreateObject("Scripting.Dictionary") 
     a = Sheets("Sheet2S").Range("A1").CurrentRegion.Value 
     For i = 2 To 10 
     'For i = 2 To UBound(a, 1) 
     .Item(a(i, 1)) = Application.Index(a, i, 0) 
    Next 

    a = Sheets("Sheet1S").Range("A1").CurrentRegion.Value 
    'For i = 2 To UBound(a, 1) 
    For i = 2 To 10 
     If .exists(a(i, 1)) Then 
      a(i, 2) = .Item(a(i, 1))(2) 
      'a(i, 4) = .Item(a(i, 2))(3) 
     Else 
      a(i, 2) = "#N/A" 
     End If 
    Next i 
    End With 
    Sheets("Sheet1S").Range("a1").CurrentRegion.Value = a 
End Sub 

今古いスレッド（How to optimize vlookup for high search count ? (alternatives to VLOOKUP)）に係る辞書方法は、ほんの数秒でなければなりません。 Application.Vlookupを使用すると、まったく同じシートが私にとっては長すぎます。 Excel 2016を使用していて、Microsoft Scripting Runtimeを追加しました。私は何か間違っているのですか？

ありがとうございます。

ベスト

Answer 1

I）は、（インデックスなしで、実装をテストし、2列に限定さ：2.2秒かかりました：

Option Explicit 

'Use Early Binding: VBA Editor -> Tools -> References -> Add Microsoft Scripting Runtime 

Public Sub VLookUpTest() 
    Const N = "#,###" 
    Dim a As Variant, i As Long, d As Dictionary 
    Dim lr1 As Long, lr2 As Long, t As Double, tt As String 

    t = Timer 
    Set d = New Dictionary 
    With d 

     a = Sheets("Sheet2S").Range("A1").CurrentRegion.Columns("A:B").Formula 
     lr2 = UBound(a) 
     For i = 2 To lr2 
      .Item(a(i, 1)) = a(i, 2) 
     Next 

     a = Sheets("Sheet1S").Range("A1").CurrentRegion.Columns("A:B").Formula 
     lr1 = UBound(a) 
     For i = 2 To lr1 
      a(i, 2) = IIf(.exists(a(i, 1)), .Item(a(i, 1)), "#N/A") 
     Next i 
     Sheets("Sheet1S").Range("a1").CurrentRegion.Columns("A:B").Formula = a 

    End With 

tt = Format(Timer - t, "#,###.00") & " seconds" 
Debug.Print "S1 rows: " & Format(lr1, N) & "; S2 rows: " & Format(lr2, N) & "; Time: " & tt 

    'S1 rows: 50,001; S2 rows: 350,001; Time: 2.23 seconds 

End Sub