LoginSignup
32
48

More than 5 years have passed since last update.

@furano_kumarin(富良野 くまりん)

Excel VBAでVLookup風な処理を高速かつ柔軟に動作させる方法

Last updated at Posted at 2016-12-25

何の話？

結論から書くと、Excel VBAでVLookup(正確にはApplication.WorksheetFunction.vlookup)を使わないほうが、処理が高速化できるし処理が柔軟に行えるよ、って話です。タイトルがVLookup 風 なのは、そういう理由です。

はじめに

Excel VBAでVLookupのような処理を実装するにあたり、同じ処理を行うのであれば他にも方法があると思えたので、それぞれコードを書いて速度を比較してみました。

条件1

対象とするExcelブック①

Sheet1 は作業シートです。1列目(A列)に入力された値をもとに、2列目(B列)に県境所在地を入力させます。
1行目は項目名のため、実データは2行目以降に入力されています。1列目に怪しい値が入力されることも考慮します。

Sheet1

A B
1 都道府県名 県庁所在地
2 神奈川県
3 愛知県
4 大阪府
5 うどん県
6 福岡県

Sheet2 は都道府県シートです。1列目(A列)には都道府県コード、2列目(B列)には都道府県名、3列目(C列)には県庁所在地が入力されています。
1行目は項目名のため、実データは2行目以降に入力されています。以下のシートのイメージは一部省略してあります。

Sheet2

A B C
1 都道府県コード 都道府県名 県庁所在地
2 1 北海道 札幌市
3 2 青森県 青森市
4 3 岩手県 盛岡市
5 4 宮城県 仙台市
(省略) (省略) (省略) (省略)
45 44 大分県 大分市
46 45 宮崎県 宮崎市
47 46 鹿児島県 鹿児島市
48 47 沖縄県 那覇市

VLookup関数

Excel関数で書くと以下のようになります。

=VLOOKUP(検索値, 範囲, 列番号 [,検索方法])

B2セルに入力する場合、以下のようになります。

=VLOOKUP($A2, Sheet2!$B$2:$C$48, 2, FALSE)

VBAで範囲を全て処理させる場合、以下のように書くことができます。

Sub vlookup()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    '検索範囲を指定する
    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 3))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    'VLookupでSheet1に入力された都道府県名から、Sheet2の指定した範囲から県庁所在地を求める
    '発見できなかった場合エラーとなりマクロが停止するので、On Errorステートメントで制御する
    For workTmpR = 2 To workEndR
        tmpStr = workSh.Cells(workTmpR, 1).Value
        On Error Resume Next
        workSh.Cells(workTmpR, 2).Value = Application.WorksheetFunction.vlookup(tmpStr, prefRng, 2, False)
        If Err <> 0 Then
            workSh.Cells(workTmpR, 2).Value = "ERROR"
            Err.Clear
        End If
    Next
End Sub

条件2

対象とするExcelブック②

Sheet1は作業シートです。①と殆ど変わりませんが、1列目(A列)に入力された値をもとに、2列目(B列)に都道府県コードを入力させます。

Sheet1

A B
1 都道府県名 都道府県コード
2 神奈川県
3 愛知県
4 大阪府
5 うどん県
6 福岡県

Sheet2 は都道府県シートです。①と同じものを使用するので省略します。

VLookup関数

VLookup関数は、1番目の引数で与えた値をキーとして、2番目の引数で指定した範囲の一番左の列を検索して、3番目の引数で与えた行数分の右側にある列の値を返す関数です。
そのため、今回の要件のような検索範囲の左側にある列を返すことができません。なので、今回のパターンではVLookupは使用できません。

Index関数 + Match関数

検索範囲としたい列の左側を取り出したい場合に使う場合の常套手段がIndex関数とMatch関数の組み合わせです。

Index関数とMatch関数は、それぞれ以下のように使用します。

=INDEX(範囲, 行番号, 列番号)
=MATCH(検索値, 範囲 [,照合の型])

B2セルにExcel関数で書く場合、以下のようになります。

=INDEX(Sheet2!$A$2:$A$48, MATCH(Sheet1!$A2, Sheet2!$B$2:$B$48, 0), 1)

VBAで範囲を全て処理させる場合、以下のように書くことができます。

Sub index_match()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    'Match関数で検索する範囲とIndex関数で返答する範囲を指定する
    Dim prefRng, codeRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))
    Set codeRng = Range(prefSh.Cells(2, 1), prefSh.Cells(48, 1))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    'Match関数で都道府県名が入力されている行数と求めた後、Index関数で対象行に格納された都道府県コードを取り出す
    '発見できなかった場合エラーとなりマクロが停止するので、On Errorステートメントで制御する
    For workTmpR = 2 To workEndR
        tmpStr = workSh.Cells(workTmpR, 1).Value
        On Error Resume Next
        workSh.Cells(workTmpR, 2).Value = Application.WorksheetFunction.Index(codeRng, Application.WorksheetFunction.match(tmpStr, prefRng, 0), 1)
        If Err <> 0 Then
            workSh.Cells(workTmpR, 2).Value = "ERROR"
            Err.Clear
        End If
    Next
End Sub

Match関数

今回のパターンの場合、VBAで書くとIndex関数はむしろ無駄なので、Match関数のみで処理する方が効率的です。
VBAで範囲を全て処理させる場合、以下のように書くことができます。Match関数は範囲の相対位置を返すので、項目行の分の1を加えています。
prefRngオブジェクトをセットする時に1行目から範囲を指定すれば、1の加算は不要です。

Sub match()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    For workTmpR = 2 To workEndR
        tmpStr = workSh.Cells(workTmpR, 1).Value
        On Error Resume Next
        workSh.Cells(workTmpR, 2).Value = prefSh.Cells(Application.WorksheetFunction.match(tmpStr, prefRng, 0) + 1, 1)
        If Err <> 0 Then
            workSh.Cells(workTmpR, 2).Value = "ERROR"
            Err.Clear
        End If
    Next
End Sub

Findメソッド

RangeオブジェクトのFindメソッドでも出来そうなので作ってみました。

Sub find()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))

    Dim workEndR, workTmpR As Long, tmpStr As String, foundCell As Object
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    'Findメソッドで範囲から対象のセルを検索する
    '発見できなかった場合はNothingとなる
    For workTmpR = 2 To workEndR
        tmpStr = workSh.Cells(workTmpR, 1).Value
        Set foundCell = prefRng.find(tmpStr, LookAt:=xlWhole)
        If foundCell Is Nothing Then
            workSh.Cells(workTmpR, 2).Value = "ERROR"
        Else
            workSh.Cells(workTmpR, 2).Value = prefSh.Cells(foundCell.Row, 1)
        End If
    Next
End Sub

速度比較

Excelブックの条件を①に戻して、都道府県名から県庁所在地を取り出します。
ただし、今回は検索量を多くするために、1000回ループを回しています。

対象とするExcelブック③

Sheet1は作業シートです。①と殆ど変わりませんが、処理量を多くするために47都道府県すべてを適当に並べています。
1列目(A列)に入力された値をもとに、2列目(B列)に都道府県コードを入力させます。
1県だけ意図的にエラーになるようしています。ループの度に並びを変えるような器用なことは行っていません。

Sheet1

A B
1 都道府県名 都道府県コード
2 神奈川県
3 愛知県
4 大阪府
5 うどん県
6 福岡県
(省略) (省略) (省略)
46 東京都
47 和歌山県
48 千葉県

Sheet2 は都道府県シートです。①と同じものを使用するので省略します。

VBAスクリプト

前述のスクリプトと基本的には変わりません。ScreenUpdate、ループ、速度計算用のコードを追加してあります。

Module1.bas
Option Explicit

Sub vlookup_loop()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 3))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    Dim t, i As Long
    Application.ScreenUpdating = False
    t = Timer
    For i = 0 To 1000
        For workTmpR = 2 To workEndR
            tmpStr = workSh.Cells(workTmpR, 1).Value
            On Error Resume Next
            workSh.Cells(workTmpR, 2).Value = Application.WorksheetFunction.vlookup(tmpStr, prefRng, 2, False)
            If Err <> 0 Then
                workSh.Cells(workTmpR, 2).Value = "ERROR"
                Err.Clear
            End If
        Next
    Next
    Application.ScreenUpdating = True
    Debug.Print "vlookup: " & (Timer - t) & " [s]"
End Sub

Sub index_match_loop()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng, cityRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))
    Set cityRng = Range(prefSh.Cells(2, 3), prefSh.Cells(48, 3))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    Dim t, i As Long
    Application.ScreenUpdating = False
    t = Timer
    For i = 0 To 1000
        For workTmpR = 2 To workEndR
            tmpStr = workSh.Cells(workTmpR, 1).Value
            On Error Resume Next
            workSh.Cells(workTmpR, 2).Value = Application.WorksheetFunction.Index(cityRng, Application.WorksheetFunction.match(tmpStr, prefRng, 0), 1)
            If Err <> 0 Then
                workSh.Cells(workTmpR, 2).Value = "ERROR"
                Err.Clear
            End If
        Next
    Next
    Application.ScreenUpdating = True
    Debug.Print "index_match: " & (Timer - t) & " [s]"
End Sub

Sub match_loop()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))

    Dim workEndR, workTmpR As Long, tmpStr As String
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    Dim t, i As Long
    Application.ScreenUpdating = False
    t = Timer
    For i = 0 To 1000
        For workTmpR = 2 To workEndR
            tmpStr = workSh.Cells(workTmpR, 1).Value
            On Error Resume Next
            workSh.Cells(workTmpR, 2).Value = prefSh.Cells(Application.WorksheetFunction.match(tmpStr, prefRng, 0) + 1, 3)
            If Err <> 0 Then
                workSh.Cells(workTmpR, 2).Value = "ERROR"
                Err.Clear
            End If
        Next
    Next
    Application.ScreenUpdating = True
    Debug.Print "match: " & (Timer - t) & " [s]"
End Sub

Sub find_loop()
    Dim workSh, prefSh As Worksheet
    Set workSh = ThisWorkbook.Worksheets("Sheet1")
    Set prefSh = ThisWorkbook.Worksheets("Sheet2")

    Dim prefRng As Range
    Set prefRng = Range(prefSh.Cells(2, 2), prefSh.Cells(48, 2))

    Dim workEndR, workTmpR As Long, tmpStr As String, foundCell As Object
    workEndR = workSh.Cells(Rows.Count, 1).End(xlUp).Row

    Dim t, i As Long
    Application.ScreenUpdating = False
    t = Timer
    For i = 0 To 1000
        For workTmpR = 2 To workEndR
            tmpStr = workSh.Cells(workTmpR, 1).Value
            Set foundCell = prefRng.find(tmpStr, LookAt:=xlWhole)
            If foundCell Is Nothing Then
                workSh.Cells(workTmpR, 2).Value = "ERROR"
            Else
                workSh.Cells(workTmpR, 2).Value = prefSh.Cells(foundCell.Row, 3)
            End If
        Next
    Next
    Application.ScreenUpdating = True
    Debug.Print "find: " & (Timer - t) & " [s]"
End Sub

実行結果

関数 1回目 2回目 3回目 平均
VLookup 2.992188 2.9375 2.90625 2.945312
Index + Match 2.75 2.742188 2.78125 2.757812
Match 2.5625 2.625 2.53125 2.572916
Find 4.15625 4.148438 4.15625 4.153646

マクロのシンプルさから何となく予想はしていましたが、Match関数が最速です。意外なのはIndex関数＋Match関数のほうが、VLookup関数より高速なことでしょうか。
Findメソッドを使う方法が一番遅いのもマクロの煩雑さから予想はしていましたが、Match関数に比べて約40%も処理が遅いとは…。

まとめ

Excel VBAでVLookup風の処理をしたいのであれば、Match関数を使いましょう！ 以上！

32
48
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
32
48