VBAのVLOOKUPの速度向上について

質問

VBAでVLOOKUPの速度向上について、お知恵を貸していただきたく存じます。
以下のVLOOKUPのVBAがおそく、速くしたいです。行数は２万行ぐらいです。
何卒よろしくお願い申し上げます。

Dim 範囲A As Range
Set 範囲A = Worksheets("取引先").Range("A:H")

On Error Resume Next
myCnt5 = 2
Do
Worksheets("受注データ").Cells(myCnt5, 49).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt5, 48), 範囲A, 6, False)
myCnt5 = myCnt5 + 1
If Worksheets("受注データ").Cells(myCnt5, 1).Value < 10 Then Exit Do
Loop

On Error Resume Next
myCnt6 = 2
Do
Worksheets("受注データ").Cells(myCnt6, 51).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt6, 50), 範囲A, 8, False)
myCnt6 = myCnt6 + 1
If Worksheets("受注データ").Cells(myCnt6, 1).Value < 10 Then Exit Do
Loop

On Error Resume Next
myCnt7 = 2
Do
Worksheets("受注データ").Cells(myCnt7, 53).Value = WorksheetFunction.VLookup(Worksheets("受注データ").Cells(myCnt7, 52), 範囲A, 6, False)
myCnt7 = myCnt7 + 1
If Worksheets("受注データ").Cells(myCnt7, 1).Value < 10 Then Exit Do
Loop

補足
上記VBAには記載していませんが、Application.ScreenUpdatingの停止、Application.Calculationを手動の設定はしています。

回答No.4

imogasi

#3です。
＞上記VBAには記載していませんが、Application.ScreenUpdatingの停止、Application.Calculationを手動の設定はしています。
それScreenUpdatingと対で、もう一つ最初と最後に、下記Application.Calculation も入れておくのが、常識かもしれません。
質問では述べていないので、ワークシート関数が、質問のＶＢＡコードで言及している以外のセルで、設定されているかどうかわかりませんが。
まあ、ないのでしょうが。念のため。
Sub test03()
Application.Calculation = xlCalculationManual 　'自動再計算を止める
End Sub
Sub test04()
Application.Calculation = xlCalculationAutomatic '自動再計算を行って終わる
End Sub

お礼

ありがとうございます。回答が遅くやりすみません。助かりました！

回答No.3

imogasi

小生は経験・勉強不足で、エクセルのＶＢＡの「処理スピードを上げる」方法論に疎い。
２万行程度のデータ量で、遅いというのが不思議なんですが。
でも、質問コードを一読して、「各行のデータの順次処理」をする方式ならば
下記はどうだろうか。
やる気があれば、改良して、やってみて下さい。
（１） VLOOKUP法のまま
３パスを１パスで処理する。
Ｄｏループ３回使用しているのを、ＦｏｒＮｅｘｔ一回で済ます。
Sub test01()
Dim 検索範囲A As Range
Set 検索範囲A = Worksheets("取引先").Range("A2:H25000") '具体的に行番号まで書く
Set 受注シート = Worksheets("受注データ")
Set wf = Application.WorksheetFunction
For i = 2 To Lr 'Lrは後述
For j = 49 To 53 Step 2
検索データ = 受注シート.Cells(i, j - 1)
Set 受注 = 受注シート.Cells(i + 2, j)
受注 = wf.VLookup(検索データ, 検索範囲A, 6, False)
受注.Offset(2, 0) = wf.VLookup(検索データ, 検索範囲A, 6, False)
受注.Offset(4, 0) = wf.VLookup(検索データ, 検索範囲A, 6, False)
Next j
Next i
End Sub
Forの行のLrは処理の最終行（番号）を目視でつかみ、ここへ数字を入れてください。
速くなるかどうかのテストですので異例のやり方です。
早くなるようでしたらこれを割り出すコードを作れないか考えることにする。
質問には、具体的なデータの提示がなく（大きい表で不可能ですが）、こちらで作ることも
うまく行かないので、あくまでヒント的なことにとどまっていますが。
(2)　Ｆｉｎｄ法
上記のＶＬＯＯＫＵＰ関数（ＭＡＴＣＨ関数でも同じ）の箇所を、検索範囲A.Find(検索データ)として、列指定のため（ＶＢＡのＲａｎｇｅの）Ｏｆｆｓｅｔを使って、ほしいデータの行と列を求める。
ーーー
参考　勝手な小生の例　Ｏｆｆｓｅｔの使い方
Sub test03()
Dim 範囲A As Range
Set 範囲A = Worksheets("取引先").Range("F2:G7")
Set 取引先 = Worksheets("取引先")
For i = 2 To 4
x = 取引先.Cells(i, 1)
MsgBox x
取引先.Cells(i, 2) = 範囲A.Find(x).Offset(0, 1)
Next i
End Sub

回答No.2

mitarashi

#1です。
http://okwave.jp/qa/q9079324.html
の補足です。
１．最速はAutoFilterにCriteriaを配列で渡した場合でした。
２．Worksheet間での結合クエリは可能でした。AutoFilterの次に速かったですが、Jet4.0プロバイダーに対して、ace12.0プロバイダーだと3倍くらい遅くなりました。但し、CSVにリンクしたワークシートに対して適用すると前者はエラーになりました（深く追求しておりません、いずれもxlsmファイルです）
方法msec
AutoFilter一括(Criteriaに配列指定）265
ワークシート間で内部結合クエリ(Jet4.0) xlsm形式655
ワークシート間で内部結合クエリ(ace12.0) xlsm形式2090
重複対応連想配列2605
AdvancedFilter一括29391
両リストをVariant配列に取込み照合（一括貼付）30467
Find&FindNextを1000回実行217887
ワークシートでADO(key毎にSELECT文1000回実行）1539792
なお、AutofilterのCriteriaに与えられる配列のサイズの上限は未調査です。
以上

お礼

ありがとうございます。回答が遅くなりすみません。助かりました！

回答No.1

mitarashi

以前にも高速化ネタで回答した者ですが、
http://okwave.jp/qa/q9079324.html
で紹介した連想配列が、ここでも速いと考えます。(完全一致の場合に限られますが)
上記の例と同様12万行のデータから、1000個を表引きします。
連想配列だと、840msec程度、Vlookupだと、4倍くらいかかり、3300msec位でした。
簡単な例を提示させていただきますが、その前に上記リンク先の回答に誤り・不十分な点がありましたので、この質問の場をお借りして、別回答で補足させていただきたいと存じます。
' 843msec
Sub vlookup_vs_dic2()
Dim targetRange As Range, refRange As Range, destRange As Range
Dim starttime As Long
Dim targetTable As Variant, refTable As Variant
Dim i As Long
Dim myDic As Object

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

starttime = GetTickCount

With Sheets("Sheet1")
Set targetRange = .Range(.Range("C2"), .Range("C" & .Rows.Count).End(xlUp)).Resize(, 7)
End With
With Sheets("Sheet4")
Set refRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
Set destRange = Sheets("Sheet5").Range("A1")

Set myDic = CreateObject("Scripting.Dictionary")
'高速化のためVariant配列に入れて置く
targetTable = targetRange.Value
refTable = refRange.Value
'辞書への収納
For i = 1 To UBound(targetTable, 1)
myDic(targetTable(i, 1)) = targetTable(i, 7)
Next i
'辞書引き
For i = 1 To UBound(refTable, 1)
'一旦Variant配列に受けて一括貼り付けすると更に20msec位速くなった
destRange.Offset(i - 1, 0).Value = myDic(refTable(i, 1))
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

Debug.Print CStr(GetTickCount - starttime)
End Sub

'3354 msec
Sub vlookup_vs_dic1()
Dim targetRange As Range, refRange As Range
Dim starttime As Long
Dim i As Long
Dim destRange As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

starttime = GetTickCount

With Sheets("Sheet1")
Set targetRange = .Range(.Range("C2"), .Range("C" & .Rows.Count).End(xlUp)).Resize(, 7)
End With
'refRangeの1000個もVariant配列に入れて試したが速度差は殆どなし
With Sheets("Sheet4")
Set refRange = .Range(.Range("A2"), .Range("A" & .Rows.Count).End(xlUp))
End With
Set destRange = Sheets("Sheet5").Range("A1")

For i = 1 To refRange.Rows.Count
destRange.Offset(i - 1, 0).Value = Application.WorksheetFunction.VLookup(refRange(i, 1).Value, targetRange, 7, False)
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

Debug.Print CStr(GetTickCount - starttime)
End Sub