マクロVLOOKUPの高速化・・・

Question

数日前の質問(ttp://oshiete.goo.ne.jp/qa/6327928.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

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

merlionXX · Accepted Answer

多分、サンプルデータの検索値の問題だと思います。
> 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

end-u · Answer

関連質問があったんですね。気づきませんでした。
タイミングが合わなくてレスできませんでしたが
検索値が数値であっても、
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オブジェクトを使った高速な処理は
もはや定番化してますからね。
プロパティやメソッドもシンプルで難しくないですから、
使える時は使ったほうが良いとは思います。

hananoppo · Answer

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

hananoppo · Answer

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

Wendy02 · Answer

>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

hananoppo · Answer

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

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

マクロVLOOKUPの高速化・・・

多分、サンプルデータの検索値の問題だと思います。

関連質問があったんですね。

ANo.4です。

ANo.1です。

>dictionaryオブジェクトを使った例があり

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

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

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

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