マクロVLOOKUPの高速化

Question

シート１には13,000行、
シート区分マスターには25,000行において
シート１の検索値からシート区分マスターを検索して
ヒットしたらシート１に返したいです。
シート１のデータ行文行いたいです。
シート１の行数は常に変化、
シート区分マスターの行数は固定です。

以下の記述で検索を行いますが終了するのに
５分強かかります。
（下のほうに再計算０％→５％→７０％→９５％と表示されている）
もっと早く処理させる方法はありますでしょうか？
よろしくお願いします。

Sub 区分検索()

'2010 年11月18日
'シート１のＡ列を検索値として
'シート区分マスターのＡ列を検索しヒットしたら
'シート区分マスターの該当行のＥ列をシート１のＣ列に転記
'データはそれぞれのシートともに２列目からである
'ヒットしない場合はシート１のＣ列は空白にする

'検索値と転記するセルのシート選択
 With Sheets("シート１")
'データ開始行のC2に式を入れる
 .Range("C2").Formula = _
 "=IF(ISNA(VLOOKUP(A2,区分マスター!$A:$E,5,FALSE)),"""",VLOOKUP(A2,区分マスター!$A:$E,5,FALSE))" '数式入力
'式によって抽出されてC列に転記された値をコピーします。
 .Range("C2").Copy .Range("C2:C" & .Range("A" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
 .Columns("C:C").Copy
'コピーした値をC1から値貼付を行う
 .Range("C1").PasteSpecial Paste:=xlPasteValues 'C列を値に変換
 Application.CutCopyMode = False
 End With
End Sub

end-u · Accepted Answer

元々、Sub dictest2()は、
VLOOKUPと同じ答えを出すと同時に、
"区分マスター"に重複がある、
という事をチェックしてもらう為に書いたものです。

例えば

Ａ列　Ｂ列
key 　item
a　　　1
b　　　2
c　　　3
a　　　4

このような『マスタ』で"a"をVLOOKUP検索すると
=VLOOKUP("a",A:B,2,0)
=1
となります。
先に見つかった"a"のitem 1 が答えです。

Sub dictest()では
>For i = 1 To UBound(v)
>　　dic(v(i, 1)) = i
>Next
この箇所で、dictionaryオブジェクトにkeyを登録してます。
上の例でいけば
"a","b","c","a"..です。
"a"が重複していた場合は後の"a"で【上書き】されます。
この時登録されるitemは 4 です。

だから、このような登録の仕方をすると
取り出されるkeyは、【後】から登録した"a"で、itemは 4 になります。

対して、Sub dictest2()では
>For i = 1 To UBound(v)
>　　'修正箇所
>　　If dic.exists(v(i, 1)) Then
>　　　　Debug.Print "重複", v(i, 1)
>　　Else
>　　　　dic(v(i, 1)) = w(i, 1)
>　　End If
>Next
この箇所で、dictionaryオブジェクトにkeyを登録してます。
If dic.exists(v(i, 1)) Then ...existsメソッドを使って、
keyが【既に】登録されていれば、
登録せずに[イミディエイトウィンドウ]に"重複"..と書き出します。
keyが未登録だったら登録します。

Sub dictest2()では
取り出されるkeyは、【前】に登録した"a"で、itemは 1 になります。

VLOOKUPと同じ動きをするのはSub dictest2()です。
『マスタ』に重複がなく、ユニークなkeyであれば
Sub dictest()もSub dictest2()も同じ結果になります。
速度的に有利なのはSub dictest()だと思います。

dictionaryオブジェクトを使ってデータ検索をする場合、
検索データが重複していた場合に、前優先か後優先かで
コードの書き方が変わります。
検索と同時に重複をチェックしたいなら、
Sub dictest2()のようにexistsメソッドを使います。

あるいはSub dictest()でkeyを登録する時に、逆にLoopすれば
：
For i = UBound(v) To 1 Step -1
　　dic(v(i, 1)) = i
Next
：
前優先になります。

結論として、
『マスタ』の重複はあり得ないのが基本だと思いますから、
Sub dictest()で良いはずです。

end-u · Answer

>VLOOKUPで行った時と
>この記述で行った時で
>返ってきた値が相違する行が２，０００行ほどあります。
ありゃ。
そうですか。

Sub dictest2()
　　Dim dic As Object
　　Dim i　 As Long
　　Dim v, w
　　Dim t As Single

t = Timer
　　With Sheets("区分マスター")
　　　　With .Range("E2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = .Columns(1).Value
　　　　　　w = .Columns(5).Value
　　　　End With
　　End With
　　Set dic = CreateObject("scripting.dictionary")
　　For i = 1 To UBound(v)
　　　　'修正箇所
　　　　If dic.exists(v(i, 1)) Then
　　　　　　Debug.Print "重複", v(i, 1)
　　　　Else
　　　　　　dic(v(i, 1)) = w(i, 1)
　　　　End If
　　Next
　　With Sheets("シート１")
　　　　With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = .Value
　　　　　　For i = 1 To UBound(v)
　　　　　　　　If dic.exists(v(i, 1)) Then
　　　　　　　　　　v(i, 1) = dic(v(i, 1))
　　　　　　　　Else
　　　　　　　　　　v(i, 1) = "無"
　　　　　　　　End If
　　　　　　Next
　　　　　　With .Offset(, 2)
　　　　　　　　.ClearContents
　　　　　　　　.Value = v
　　　　　　End With
　　　　End With
　　End With
　　Set dic = Nothing
　　Debug.Print Timer - t
End Sub

これでチェックしてください。
実行後、VBE画面[ctrl]+[g]キー。[イミディエイトウィンドウ]に
"重複" キーが書き出されてたら、Sheets("区分マスター")が重複してます。
"マスター"なのでキー重複はないと判断しましたが、
あれば、それも問題ですね。

merlionXX · Answer

おはようございます、gx9wxさん。
一夜明けたら、わたしが常に尊敬するend-uさまから、驚異的なコードが提案されていますね！
VLOOKUP検索のかわりにDictionaryオブジェクトを使うなんて、これまで考えたこともなかった・・・。

2万行でためしたらわずか0.625秒！
比較にもなりません。
end-uさま、脱帽です。(o。_。)oペコッ

よい勉強をさせていただきました。

end-u · Answer

>dictionaryオブジェクトを使ったりする事になります。
一応、サンプル書いておきますね。

Sub dictest()
　　Dim dic As Object
　　Dim i　 As Long
　　Dim v, w
　　Dim t As Single

t = Timer
　　With Sheets("区分マスター")
　　　　With .Range("E2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = .Columns(1).Value
　　　　　　w = .Columns(5).Value
　　　　End With
　　End With
　　Set dic = CreateObject("scripting.dictionary")
　　For i = 1 To UBound(v)
　　　　dic(v(i, 1)) = i
　　Next
　　With Sheets("シート１")
　　　　With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = .Value
　　　　　　For i = 1 To UBound(v)
　　　　　　　　If dic.exists(v(i, 1)) Then
　　　　　　　　　　v(i, 1) = w(dic(v(i, 1)), 1)
　　　　　　　　Else
　　　　　　　　　　v(i, 1) = "無"
　　　　　　　　End If
　　　　　　Next
　　　　　　With .Offset(, 2)
　　　　　　　　.ClearContents
　　　　　　　　.Value = v
　　　　　　End With
　　　　End With
　　End With
　　Set dic = Nothing
　　Debug.Print Timer - t
End Sub

『vba scripting.dictionary』でnet検索して勉強してみてください。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html

end-u · Answer

VLookup自体が重いので、劇的に改善しようと思えば
dictionaryオブジェクトを使ったりする事になります。

Sub 区分検索02()を少しでも改善するなら
Sub test1()
　　Dim r　As Range
　　Dim ri As Range
　　Dim t As Single

t = Timer
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　
　　With Sheets("シート１")
　　　　Set r = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 2)
　　End With
　　r.ClearContents
　　On Error Resume Next
　　For Each ri In r
　　　　ri.Value = WorksheetFunction.VLookup(ri.Offset(, -2), Worksheets("区分マスター").Range("A1:E60000"), 5, 0)
　　Next
　　On Error GoTo 0
　　r.Replace "", "無", xlWhole
　　
　　Application.Calculation = xlCalculationAutomatic
　　Application.ScreenUpdating = True
　　Debug.Print Timer - t
End Sub

また、ApplicationレベルでVLookupを使って配列に対して処理をすると
環境によっては速く処理できます。
#Excel2000では配列制限があるためこのままでは使えないです。
Sub test2()
　　Dim v
　　Dim t As Single

t = Timer
　　With Sheets("シート１")
　　　　With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = Application.VLookup(.Value, Worksheets("区分マスター").Range("A1:E60000").Value, 5, 0)
　　　　　　With .Offset(, 2)
　　　　　　　　.ClearContents
　　　　　　　　.Value = v
　　　　　　　　.Replace "#N/A", "無", xlWhole
　　　　　　End With
　　　　End With
　　End With
　　Debug.Print Timer - t
End Sub

merlionXX · Answer

画面停止だけじゃなく、計算停止も

Sub 区分検索02()
　　With Sheets("シート１")
　　　　Application.ScreenUpdating = False
　　　　Application.Calculation = xlCalculationManual
　　　　.Range("C2").Formula = _
　　　　"=IF(ISNA(VLOOKUP(A2,区分マスター!$A:$E,5,FALSE)),"""",VLOOKUP(A2,区分マスター!$A:$E,5,FALSE))"
　　　　.Range("C2").Copy .Range("C2:C" & .Range("A" & .Rows.Count).End(xlUp).Row)
　　　　Application.Calculation = xlCalculationAutomatic
　　　　.Columns("C:C").Copy
　　　　.Range("C1").PasteSpecial Paste:=xlPasteValues
　　　　Application.CutCopyMode = False
　　　　Application.ScreenUpdating = True
　　End With
End Sub

FEX2053 · Answer

とりあえず、処理の前後に

Application.ScreenUpdating = False　/　True

を入れて、画面の逐次表示を止めて見たら？

マクロVLOOKUPの高速化

元々、Sub dictest2()は、

>VLOOKUPで行った時と

おはようございます、gx9wxさん。

>dictionaryオブジェクトを使ったりする事になります。

この回答への補足

VLookup自体が重いので、劇的に改善しようと思えば

この回答への補足

画面停止だけじゃなく、計算停止も

とりあえず、処理の前後に

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング