ExcelマクロVBA技術解説 | 大量VlookupをVBAで高速に処理する方法について | Excelマクロの問題点と解決策、エクセルVBAの技術的解説



最終更新日:2017-12-12

大量VlookupをVBAで高速に処理する方法について

大量データ同士のVlookup処理は、非常に時間のかかる処理となります、

マクロVBAで、これを高速に処理する方法について、VBAコードを示し解説します。


ワークシート上の関数の場合

シートに関数を入れる場合は、以下を参照してください。


【奥義】大量データでの高速VLOOKUP


以下の表で検証します。





Sheet1、Sheeet2ともに10万行までデータがあります。

Sheet1のA列で、Sheet2のA列を検索し、
一致したSheet2のB列を、Sheet1のB列に入れます。

シートの関数であれば、
=VLOOKUP(A2,Sheet2!A:B,2,FALSE)
これを10万行いれると、とても時間がかかるのでVBAで何とかしようという事です。

まずは、検証するためのVBAが必要です。

検証するためのマクロVBA

Sub test()
  Dim rng検索値 As Range
  Dim rng検索範囲 As Range
  Dim rng出力範囲 As Range
  Set rng検索値 = Worksheets("Sheet1").Range("A2:A100001")
  Set rng検索範囲 = Worksheets("Sheet2").Range("A2:B100001")
  Set rng出力範囲 = Worksheets("Sheet1").Range("B2:B100001")
  
  Application.ScreenUpdating = False
  Debug.Print Timer
  Call sample○(rng検索値, rng検索範囲, 2, rng出力範囲)
  Debug.Print Timer
  Application.ScreenUpdating = True
End Sub

sample○
この部分を取り換えて、複数のプロシージャーを検証します。



速度を何も考慮しないVBA

Sub sample1(ByVal rng検索値 As Range, _
      ByVal rng検索範囲 As Range, _
      ByVal 列位置 As Integer, _
      ByVal rng出力範囲 As Range)
  Dim i As Long
  For i = 1 To rng検索値.Rows.Count
    rng出力範囲(i, 1) = WorksheetFunction.VLookup( _
                rng検索値(i, 1), _
                rng検索範囲, _
                列位置, _
                0)
  Next
End Sub

普通に、
WorksheetFunction.VLookup
これで取得しています。
これは、シート関数そのものですので、速いはずがありません。
シートに関数を入れての再計算と同じ、むしろそれよりも時間がかかってしまいます。
それでも、ブックが重くなってしまうという事は避けられます。
たまに受ける相談で、
「シートに関数を入れたら再計算に時間がかかるのでマクロでやりたい。」
シート関数をマクロにしただけではあまり意味がないという事です。

10万行でテストしたところ、10分程度かかりました。



これではどうしようもないので、VBAコードを対策します。

基本的な速度アップの考え方



Dictionaryを使う

Sub sample2(ByVal rng検索値 As Range, _
      ByVal rng検索範囲 As Range, _
      ByVal 列位置 As Integer, _
      ByVal rng出力範囲 As Range)
  Dim i As Long
  Dim ary()
  Dim myDic As New Dictionary
  For i = 1 To rng検索範囲.Rows.Count
    If Not myDic.Exists(rng検索範囲(i, 1).Value) Then
      myDic.Add rng検索範囲(i, 1).Value, rng検索範囲(i, 1).Offset(, 列位置 - 1).Value
    End If
  Next
  ReDim Preserve ary(1 To rng出力範囲.Rows.Count, 1 To 2)
  For i = 1 To rng検索値.Rows.Count
    ary(i, 1) = myDic.Item(rng検索値(i, 1).Value)
  Next
  rng出力範囲.Value = ary
End Sub

Dim myDic As New Dictionary
「ツール」→「参照設定」で、
Microsoft Scripting Runtime
これを参照設定しています。
参照設定しない場合は、
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
Dictionary全般については、以下を参考にしてください。
最初に検索範囲を、Dictionaryに全て入れてしまい、
検索値の全行に対して、検索値でDictionaryから値を取得しています。

このマクロVBAで、2.5秒〜2.8秒程度で完了します。
十分に速いものとなっています。



並べ替えと配列を使う

Sub sample4(ByVal rng検索値 As Range, _
      ByVal rng検索範囲 As Range, _
      ByVal 列位置 As Integer, _
      ByVal rng出力範囲 As Range)
  Dim wb As Workbook
  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim i1 As Long
  Dim i2 As Long
  Dim rMax1 As Long
  Dim rMax2 As Long
  Dim ary1
  Dim ary2
  Dim ary3
  
  Set wb = Workbooks.Add
  Set ws1 = wb.Worksheets(1)
  Set ws2 = wb.Worksheets.Add
  
  rMax1 = rng検索値.Rows.Count
  rMax2 = rng検索範囲.Rows.Count
  ary1 = rng検索値
  ReDim Preserve ary1(1 To rMax1, 1 To 2)
  For i1 = 1 To UBound(ary1, 1)
    ary1(i1, 2) = i1
  Next
  ws1.Range("A1").Resize(rMax1, 2).Value = ary1
  ws2.Range("A1").Resize(rMax2).Value = rng検索範囲.Columns(1).Value
  ws2.Range("B1").Resize(rMax2).Value = rng検索範囲.Columns(列位置).Value
  
  With ws1
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("A1"), Order:=xlAscending
    .Sort.SetRange .Range("A1").CurrentRegion
    .Sort.Header = xlNo
    .Sort.Apply
    ary1 = .Range("A1").CurrentRegion
  End With
  
  With ws2
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("A1"), Order:=xlAscending
    .Sort.SetRange .Range("A1").CurrentRegion
    .Sort.Header = xlNo
    .Sort.Apply
    ary2 = .Range("A1").CurrentRegion
  End With
  
  wb.Close SaveChanges:=False
  
  ReDim ary3(1 To rMax1, 1 To 1)
  i1 = 1
  i2 = 1
  Do
    Select Case True
      Case ary1(i1, 1) = ary2(i2, 1)
        ary3(ary1(i1, 2), 1) = ary2(i2, 2)
        i1 = i1 + 1
      Case ary1(i1, 1) > ary2(i2, 1)
        i2 = i2 + 1
      Case ary1(i1, 1) < ary2(i2, 1)
        i1 = i1 + 1
    End Select
    If i1 > rMax1 Or i2 > rMax2 Then
      Exit Do
    End If
  Loop
  
  rng出力範囲.Value = ary3
End Sub

新規ブックを追加し、そこに検索値と検索範囲を入れています。
並べ替えした後、それぞれを配列に入れます。
検索値と検索範囲の配列を順次比較しながら、一致していれば値を取得しています。

このマクロVBAで、2.5秒〜2.8秒程度で完了します。
Dictionaryとほぼ同様の処理速度となっています。



「Dictionaryを使う」「並べ替えと配列を使う」
ほぼ同程度の処理速度の結果となりました。
マクロVBAコードの簡潔さでいえば、Dictionaryに分がありそうです。
処理速度が同程度なので、どちらを使うかは好みになるかと思います。
場面によって使い分けすれば良いでしょう。




同じテーマ「ExcelマクロVBA技術解説」の記事

配列の使い方について
最終行の判定、Rangeオブジェクトと配列、高速化の為に
記述による処理速度の違い
速度比較決定版【Range,Cells,Do,For,ForEach】
エクセルVBAのパフォーマンス・処理速度に関するレポート
VBAのFindメソッドの使い方には注意が必要です
WorksheetFunction.Matchで配列を指定した場合の制限について

新着記事 ・・・新着記事一覧を見る

大量VlookupをVBAで高速に処理する方法について|ExcelマクロVBA技術解説(12月12日)
オセロを作りながらマクロVBAを学ぼう|ExcelマクロVBAサンプル集(11月26日)
ScreenUpdating=False時にエラー停止後にシートが固まったら|ExcelマクロVBA技術解説(11月21日)
データクレンジングと名寄せ|ExcelマクロVBA技術解説(10月20日)
SUMIFの間違いによるパフォーマンスの低下について|エクセル関数超技(6月17日)
条件式のいろいろな書き方:TrueとFalseの判定とは|ExcelマクロVBA技術解説(6月15日)
空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い分け方|ExcelマクロVBA入門
3.変数とデータ型(Dim)|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
6.オセロを作りながらマクロVBAを学ぼう|ExcelマクロVBAサンプル集
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.定数と型宣言文字(Const)|ExcelマクロVBA入門
9.ひらがな⇔カタカナの変換|エクセル基本操作
10.繰り返し処理(For Next)|ExcelマクロVBA入門



  • >
  • >
  • >
  • 大量VlookupをVBAで高速に処理する方法について

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。

    ↑ PAGE TOP