Edited at

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

More than 1 year has passed since last update.


何の話?

結論から書くと、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関数を使いましょう! 以上!