マクロVLOOKUPの高速化・・・

質問

数日前の質問(ttp://okwave.jp/qa/q6327928.html)で、
dictionaryオブジェクトを使った例があり
その実行速度は非常に速いとのコメントがあります。

それなら自分のマクロを書き換えようと思いテストしました。
しかし、私のPCでは、満足のいく結果がでませんでした。

回答#3の、test1で、34秒くらい、
回答#4の、dictestで、175秒くらいかかりました。

エクセルは2000です。osはxp_homeです。

テストデータは、次のマクロでつくりました。

Sub 編集1()
Dim 行 As Long

Sheets("区分マスター").Select
For 行 = 2 To 30000
Cells(行, 1) = 20100000 + 行
Cells(行, 3) = "ccc" & 行
Cells(行, 4) = "ddd" & 行
Cells(行, 5) = "eee" & 行
Next 行

Sheets("シート１").Select
For 行 = 2 To 15000
Cells(行, 1) = 20100000 + 行 * 2
Next 行
End Sub

アドバイス、よろしくお願いします。

回答No.3

merlionXX · ベストアンサー

多分、サンプルデータの検索値の問題だと思います。
> Cells(行, 1) = 20100000 + 行
これで作った8桁の数値が何万とあるわけですから。

わたしもやってみたら１４０秒くらいかかりました。
でもサンプルデータを以下で作って再度やったら、４秒で終わりました。

Sub 編集1()
　　With Worksheets("区分マスター")
　　　　Application.ScreenUpdating = False
　　　　Application.Calculation = xlCalculationManual
　　　　.Cells(2, 1).Formula = "=""AAA""&ROW()"
　　　　.Cells(2, 3).Formula = "=""ccc""&ROW()"
　　　　.Cells(2, 4).Formula = "=""ddd""&ROW()"
　　　　.Cells(2, 5).Formula = "=""eee""&ROW()"
　　　　.Rows(2).Copy .Range(.Rows(3), .Rows(30000))
　　　　Application.Calculation = xlCalculationAutomatic
　　　　.UsedRange.Copy
　　　　.UsedRange.PasteSpecial Paste:=xlPasteValues
　　　　Application.CutCopyMode = False
　　End With

　　With Worksheets("シート１")
　　　　Application.Calculation = xlCalculationManual
　　　　.Cells(2, 1).Formula = "=""AAA""&+ROW()*2"
　　　　Application.Calculation = xlCalculationAutomatic
　　　　.Rows(2).Copy .Range(.Rows(3), .Rows(15000))
　　　　.UsedRange.Copy
　　　　.UsedRange.PasteSpecial Paste:=xlPasteValues
　　　　Application.CutCopyMode = False
　　　　Application.ScreenUpdating = True
　　End With
End Sub

お礼

回答、ありがとうございます。

サンプルデータに問題があるとは思いませんでした。

いろいろ試した結果、キーになるデータが数字のみの場合
7桁以内・・・1秒以内で終了
8桁以上・・・175秒前後で終了(文字列に変換しても同じ結果)

キーになるデータが数字+数字以外では桁数に関係なく1秒以内で終了

一応このような結果になりました。
が、まだ他の条件があるかもしれませんのでご意見待っています。

回答No.6

end-u

関連質問があったんですね。気づきませんでした。
タイミングが合わなくてレスできませんでしたが
検索値が数値であっても、
String型配列を経由して処理すれば速いです。

Sub dictest()
　　Dim dic　As Object
　　Dim mx　 As Long
　　Dim i　　As Long
　　Dim s()　As String
　　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

　　mx = UBound(v)
　　ReDim s(1 To mx)
　　For i = 1 To mx
　　　　s(i) = v(i, 1)
　　Next
　　Set dic = CreateObject("scripting.dictionary")
　　For i = 1 To mx
　　　　dic(s(i)) = i
　　Next

　　With Sheets("シート１")
　　　　With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
　　　　　　v = .Value
　　　　　　mx = UBound(v)
　　　　　　ReDim s(1 To mx, 0)
　　　　　　For i = 1 To mx
　　　　　　　　s(i, 0) = v(i, 1)
　　　　　　Next
　　　　　　For i = 1 To mx
　　　　　　　　If dic.exists(s(i, 0)) Then
　　　　　　　　　　s(i, 0) = w(dic(s(i, 0)), 1)
　　　　　　　　Else
　　　　　　　　　　s(i, 0) = "無"
　　　　　　　　End If
　　　　　　Next
　　　　　　With .Offset(, 2)
　　　　　　　　.ClearContents
　　　　　　　　.Value = s
　　　　　　End With
　　　　End With
　　End With

　　Set dic = Nothing
　　Erase s
　　Debug.Print Timer - t
End Sub

dictionaryオブジェクトを使った高速な処理は
もはや定番化してますからね。
プロパティやメソッドもシンプルで難しくないですから、
使える時は使ったほうが良いとは思います。

お礼

end-uさん、アドバイズ、ありがとうございます。

時系列株価データのダウンロードなど、有難くつかせてもらっています。

dictionaryで、検索値が八桁以上の数値のときは、

String型配列を経由して処理すれば良かったんですね。

私は質問をしめっきったあと、いろいろ考えて次の方法で処理をしています。

Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(v)
dic.Add "@" & v(i, 1), i '"@"をつけるのは、八桁以上の数字の時
Next

これで処理時間は、一秒前後です。

回答No.5

hananoppo

ANo.4です。下から3行目の「Application.CutCopyMode = False」は不用でした。訂正します。

お礼

ありがとうございます。

回答No.4

hananoppo

ANo.1です。どうやら見当違いの回答だったようですね。検索マクロの方ですが、次のようなマクロでどうでしょう。ただし、「区分マスター」と「シート１」のA列のデータは昇順に並んでいて、重複がないものとします。

Sub Search()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim EndRow1 As Long, EndRow2 As Long
Dim i As Long, j As Long
Dim sValue As Long

Application.ScreenUpdating = False
Set Ws1 = Worksheets("区分マスター")
Set Ws2 = Worksheets("シート１")
EndRow1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row
EndRow2 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
i = 1
For j = 2 To EndRow2
sValue = Ws2.Cells(j, 1).Value
Do
i = i + 1
If Ws1.Cells(i, 1).Value = sValue Then
Ws2.Cells(j, 3).Value = Ws1.Cells(i, 5).Value
Exit Do
End If
If i = EndRow1 Then Exit For
Loop
Next j
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

お礼

再度の回答、ありがとうございます。

約2秒で終わりました。

キーになるデータが、数字のみの場合で桁数が多いときは使わせてもらいます。

回答No.2

Wendy02

>dictionaryオブジェクトを使った例があり
>その実行速度は非常に速いとのコメントがあります。

>回答#3の、test1で、34秒くらい、
>回答#4の、dictestで、175秒くらいかかりました。

Dictionary は、Officeにとって、CreateObjectでオートメーション・オブジェクトにしていますから、オーバーヘッドを消費するために、トータルでは思った程には速くなるとは思えません。ここで提示されたその数字は、理解できます。そこに違いが出るのは、何か、別の要因があるのか、私には分かりません。私のほうでは、VBEでは、順次コンパイル・モードですから、その分スピードは遅いです。

ただ、基本的には、オートメーション・オブジェクトにしろ、外部ツールにしろ、Office 内部にないものを使えば、遅くなると思ったほうがよいと思います。例えば、AccessとExcelで、同じADOを使ったとしても、Excelが遅くなるのは、通常は、ADOを参照設定しているわけではないからです。

・ExcelExcel大辞典　VBAマクロ　検索 Find メソッド VLookup 関数　配列 ADO SQL
・様々な検索方法をマスターしよう！
http://home.att.ne.jp/zeta/gen/excel/c04p42.htm

こういう実験的なマクロは、それぞれの人たちが、必要に応じて使い分ければよいと思います。ただし、PCの前でその完了まで待っている人にとっては、100分の数秒以上は、全部、遅いとは感じるかもしれません。

こうした時間感覚は、相対的なものですから、10数秒でも速いと言う人もいれば、遅すぎるから改善してくれ、という人もいます。確かに、技術的なチューンナップや基本的なコーディング・ルールを守る必要はありますが、それ以外は、ここの掲示板の範囲の問題とは違うような気がします。

なお、Microsoft 側が提示した、「VBAの最適化」をきちんと把握していればよいだけだと思います。またコーディング・ルールを守ってほしいとは思いますが、そういうことを提示しても、こういう所では、ルールの存在すら否定する人たちもいますから、可動しているものに対して、何かを言う気持ちもありません。プロパティを入れろとか、基本的なことさえ、無視したところで、問題は特に発生しません。

VBAコードを最適化する。(プログラマーズガイド Office 2000）
http://msdn.microsoft.com/ja-jp/library/cc375992.aspx
変数を宣言する/数値の演算/文字列の演算/ループ

Visual Basic コードのパフォーマンスを向上させる(Access)
http://office.microsoft.com/ja-jp/access-help/HP005186823.aspx?redir=0

お礼

回答、ありがとうございます。
Wendy02さんの回答、いつも参考にしています。
教えてもらった、ウェブページも参考にさせてもらいます。

今度の質問、聞きたいポイントがはっきりしていなかったと思います。

"マクロVLOOKUPの高速化"という題目で数日前に、
質問(http://oshiete.goo.ne.jp/qa/6327928.html)があり、
その中にdictionaryオブジェクトを使った例があります。
その実行速度は非常に速いとのコメントがあります。

しかし、私のPCでは、満足のいく結果がでませんでした。
それで、実際に実行してもらい、その結果を比べて
私のPCの問題点を発見したいとの思いでした。

回答No.1

hananoppo

ご提示のテストデータの場合、次のようなマクロであれば一瞬で作成できます。

Sub 編集1()
Worksheets("区分マスター").Activate
Cells(2, 1).Formula = "=20100000+ROW()"
Cells(2, 3).Formula = "=""ccc""&ROW()"
Cells(2, 4).Formula = "=""ddd""&ROW()"
Cells(2, 5).Formula = "=""eee""&ROW()"
Rows(2).Copy Range(Rows(3), Rows(30000))

Worksheets("シート１").Activate
Cells(2, 1).Formula = "=20100000+ROW()*2"
Rows(2).Copy Range(Rows(3), Rows(15000))
End Sub

お礼

見てもらい、ありがとうございます。

実行時間は、劇的に早くなりました。(13秒→1秒以下)

検索の方法でもアドバイスをいただければうれしいです。