こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

マクロVLOOKUPの高速化

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

以下の記述で検索を行いますが終了するのに
5分強かかります。
(下のほうに再計算0%→5%→70%→95%と表示されている)
もっと早く処理させる方法はありますでしょうか?
よろしくお願いします。

Sub 区分検索()

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

'検索値と転記するセルのシート選択
With Sheets("シート1")
'データ開始行の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

投稿日時 - 2010-11-18 16:38:24

QNo.6327928

困ってます

質問者が選んだベストアンサー

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

例えば

A列 B列
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()で良いはずです。

投稿日時 - 2010-11-22 22:19:30

お礼

勉強してくださいね。とURLまで貼ってくれたのですが、
それを見てもいまいち理解できませんでした。

今回の回答で、やっと理解しました。
すごく分かりやすい説明で、嬉しかったです。

おかげでマスターがでたらめだった事がわかり大変感謝です。
セルにVLOOKUP式を入れて運用していたのですが
気がつきませんでした。

マクロでもVLOOKUP式を貼り付けるつもりでいたので
セルに式を入れたのと同じ結果のはずで
マスターの不備は気がつかなかったと思います。

高速化でアドバイスいただいた結果マスター不備にたどり着き
大変感謝です。

どうもありがとうございました。

投稿日時 - 2010-11-24 08:59:25

ANo.7

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.6

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

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("シート1")
    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("区分マスター")が重複してます。
"マスター"なのでキー重複はないと判断しましたが、
あれば、それも問題ですね。

投稿日時 - 2010-11-19 13:13:01

お礼

どうもありがとうございました。

Sub dictest( )
→VLOOKUPで行った時と返ってきた値が相違する行が
 シート1の13,000行中、約2,000行ありました。

↓↓↓

Sub dictest2( )
→VLOOKUPで行った時と同一になりました。

 >実行後、VBE画面[ctrl]+[g]キー。
 >[イミディエイトウィンドウ]に
 >"重複" キーが書き出されてたら、
 >Sheets("区分マスター")が重複してます。

すでに解決(VLOOOKUPの時と同じになった)しましたが
念の為、上記内容を確認しました。

重複キーが出てきました。

「区分マスター」を調査したら
25,000行中A列の値の重複が約11,000行もありました。

「区分マスター」を整理整頓し、A列の値の重複は無しにしました。
結果 「区分マスター」は 25,000行 → 約14,000行 になりました。

この「区分マスター」修正後に
Sub dictest2( )をもう一度行ってみました。

→VLOOKUPで行った時と同一になりました。
→「区分マスター」修正前にSub dictest2( )で行った時と同じでした。

あれっ?と思い「区分マスター」修正後に
もう一度 Sub dictest( ) を試してみました。
→VLOOKUPで行った時と同一になりました。

原因は
「区分マスターに重複行があった為」みたいです。
 ・Sub dictest2( )を作成していただかなくても大丈夫だった
になってしまいました。
大変申し訳ありませんでした。

教えていただいた
 ・Sub dictest( )と
 ・Sub dictest2( )なのですが

Sub dictest2( )は「区分マスター」に重複があっても
VLOOKUPと同じになるので
Sub dictest2( )を使用した方が安全でしょうか?

それとも「区分マスター」に重複があると
Sub dictest( )と
Sub dictest2( )のどちらでも、相違する値が出る可能性があるのでしょうか?

 (区分マスターが重複していればVLOOKUPで行った時の
  返した値も信憑性がありません。
  重複していても返す値のあるE列の値が同じならいいのですが相違すれば
  どちらの値が返されるか分かりません。)

金曜日から混乱しています。お礼が遅れてしまいました。
申し訳ありません。

投稿日時 - 2010-11-22 18:05:27

ANo.5

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

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

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

投稿日時 - 2010-11-19 09:50:16

お礼

merlionXXさん。おはようございます。
merlionXXもありがとうございます。
いろいろ教えていただきました。
merlionXXに教えていただいた今までの物も
(このスレッド以外も含め)
私にとっては驚異的です。

さてend-uさんに教えていただいたこの記述ですが、
テストも終了しこれを使いたいと思います。
で例によって1行ごとに何をしているのか、これからコメントを入れていくのですが
完全にちんぷんかんぷんです。
URLも貼り付けてくれたのでにらめっこです。

投稿日時 - 2010-11-19 10:17:28

ANo.4

>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("シート1")
    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

投稿日時 - 2010-11-19 00:11:20

補足

申し訳ありません。
VLOOKUPで行った時と
この記述で行った時で
返ってきた値が相違する行が2,000行ほどあります。
原因が分かりません。

多分と思われるのが
シート1の検索値(シート1のA列)に重複レコードがうじゃうじゃランダムに存在するという事くらいですが
重複していない1行のみしかいない行であっても
返ってきた値が相違しています。

投稿日時 - 2010-11-19 11:51:18

お礼

信じられません。
26,000行で1秒かかりませんでした。
会社にあるエクセルシートでマクロではなくセルに直接vlookupの式を入れてある物
に流用したいと思います。
(ほとんどが15,000行を25,000行の中から検索で
 再計算とかで処理が重くて困っていました。)

どうもありがとうございました。

投稿日時 - 2010-11-19 10:04:13

ANo.3

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("シート1")
    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("シート1")
    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

投稿日時 - 2010-11-18 20:22:44

補足

2010年11月19日 12:00

申し訳ありません。
回答A-NO.4の補足で間違いです。

>VLOOKUPで行った時と
>この記述で行った時で
>返ってきた値が相違する行が2,000行ほどあります。
>原因が分かりません。

>多分と思われるのが
>シート1の検索値(シート1のA列)に重複レコードがうじゃうじゃランダムに存在するという事くらいですが
>重複していない1行のみしかいない行であっても
>返ってきた値が相違しています。

>投稿日時 - 2010-11-19 11:51:18

重複レコードはありませんでした。
ですが
VLOOKUPで行った時と
この記述で行った時で
返ってきた値が相違する行が2,000行ほどあります。

申し訳ありません。

投稿日時 - 2010-11-19 12:01:31

お礼

ありがとうございます。
かなり早くなりました。
行数を倍にしても大丈夫です。

1.ここで教えていただいた表示と式停止の場合
  13,500行=1:49
  27,000行=3:35

2.質問後自作のLOOP文(記述は最後尾に)
  13,500行=1:00
  27,000行=1:58

3.今回教えていただいたSub test1()
  13,500行=0:58
  27,000行=1:54 

4.今回教えていただいたSub test2()
  13,500行=0:49
  27,000行=1:36 



質問では式を貼付して出た値を値貼付していた

質問後自分で考えたloop文

Sub 区分検索02()

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

'検索値があるシート選択する
Sheets("シート1").Select
'そのシートの検索開始の行数を選択。2行目から開始。
Line = 2
'そのシートの検索値の列を指定1=A列。
'その値がなくなったら検索を終了させる。
Do Until Cells(Line, 1).Value = ""
'エラーとなっても次に進む
On Error Resume Next
'検索結果を転記する列を指定。Line3=C列
'検索するシートと列(1=A列)とヒットした場合のその行の返す値の列(5=E列)指定
Cells(Line, 3).Value = Application.WorksheetFunction.VLookup(Cells(Line, 1).Value, Worksheets("区分マスター").Range("A1:E60000"), 5, 0)
'VLOOKUP関数が終了又はエラーが発生したら止まる
On Error GoTo 0
'検索されなかったときの処理。
If Cells(Line, 3).Value = "" Then
Cells(Line, 3).Value = "無"
End If
'2行目から開始なので次の行の値を検索値とする
Line = Line + 1
'検索する値がなくなるまで繰返す
Loop
End Sub

投稿日時 - 2010-11-19 09:57:07

ANo.2

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

Sub 区分検索02()
  With Sheets("シート1")
    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

投稿日時 - 2010-11-18 17:45:53

お礼

5分が2分になりました。
ありがとうございます。

質問しておいてなんですが、
行数からしてLOOP文では絶対無理だと思いましたが
以下の記述だと1分で完了しました。
式を貼り付けて計算させて、でた値を値貼付するより
1行ごと処理する方が早いのでしょうか??
それとも13,000行位だと、1行ごと処理の方が早く
行数がもっと増えるとこれでは遅くなるのでしょうか?
早く処理できたにはいいのですが記述に問題があるのか
確信がもてず不安です。

Sub 区分検索02()

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

'検索値があるシート選択する
Sheets("シート1").Select
'そのシートの検索開始の行数を選択。2行目から開始。
Line = 2
'そのシートの検索値の列を指定1=A列。
'その値がなくなったら検索を終了させる。
Do Until Cells(Line, 1).Value = ""
'エラーとなっても次に進む
On Error Resume Next
'検索結果を転記する列を指定。Line3=C列
'検索するシートと列(1=A列)とヒットした場合のその行の返す値の列(5=E列)指定
Cells(Line, 3).Value = Application.WorksheetFunction.VLookup(Cells(Line, 1).Value, Worksheets("区分マスター").Range("A1:E60000"), 5, 0)
'VLOOKUP関数が終了又はエラーが発生したら止まる
On Error GoTo 0
'検索されなかったときの処理。
If Cells(Line, 3).Value = "" Then
Cells(Line, 3).Value = "無"
End If
'2行目から開始なので次の行の値を検索値とする
Line = Line + 1
'検索する値がなくなるまで繰返す
Loop
End Sub

投稿日時 - 2010-11-18 18:25:07

ANo.1

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

Application.ScreenUpdating = False / True

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

投稿日時 - 2010-11-18 16:58:01

お礼

教えていただいたとうりに行いましたが
やはり5分近くかかります。
どうもありがとうございました。

投稿日時 - 2010-11-18 17:10:48

あなたにオススメの質問