ここから本文です

マクロに関する質問 vbaを使用してvlookupを行っていますが、 数万行のデータが...

xhx********さん

2017/10/2814:18:27

マクロに関する質問
vbaを使用してvlookupを行っていますが、
数万行のデータがあるため実行完了までに時間がかかってしまいます。

配列を利用すればかなり高速になるらしいのですが、本やインターネットで調べながら行ってもうまく理解・実行ができませんでした。
どなたかご教授願います。

仕様はSheet2のA:Bに参照用のリスト
Sheet1のAが検索ワード、Bにvlookupで入力です

下記は現在使用しているマクロのサンプルです

Sub sample()
Sheets("Sheet2").Activate
z2 = Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Activate
z1 = Cells(Rows.Count, 1).End(xlUp).Row
Range("B2") = "=VLOOKUP(A2,Sheet2!$A$2:$B$" & z2 & ",2,0)"
Range("B2").AutoFill Destination:=Range("B2:B" & z1)
End Sub

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
144
回答数:
3
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

kik********さん

2017/10/2817:05:48

以下でどうなりますか

確認は、

新規ブックの標準モジュールに以下を記述し、
Sheet1 / Sheet2 があることを確認後、
testData で確認用データを作成し、Samp1 を実行してみます

★ 部分は、大文字/小文字、全角/半角等区別したくない場合、有効に


Option Explicit

Public Sub Samp1()
   Dim dic As Object
   Dim vA As Variant
   Dim i As Long

   Set dic = CreateObject("Scripting.Dictionary")
'   dic.CompareMode = vbTextCompare ' ★

   With Worksheets("Sheet2")
      With .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
         vA = .Resize(, 2).Value
      End With
   End With
   For i = UBound(vA) To 1 Step -1
      dic(vA(i, 1)) = vA(i, 2)
   Next

   With Worksheets("Sheet1")
      With .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
         vA = .Value
         For i = 1 To UBound(vA)
            vA(i, 1) = dic(vA(i, 1))
         Next
         .Offset(, 1).Value = vA
      End With
   End With

   Set dic = Nothing
End Sub



' 確認用データ作成

Public Sub testData()
   Dim r As Range
   Dim i As Long, k As Long
   Const CRH As Long = 20000 ' 行数

   Randomize

   Application.ScreenUpdating = False
   With Worksheets("Sheet2")
      .Cells.Delete
      With .Range("A2:B2").Resize(CRH)
         For Each r In .Cells
            r.Value = r.Address(False, False)
         Next
         With .Offset(CRH)
            For Each r In .Columns(1).Cells
               r.Value = r.Offset(-CRH).Address(False, False)
            Next
            For Each r In .Columns(2).Cells
               r.Value = r.Address(False, False)
            Next
         End With
      End With
   End With

   With Worksheets("Sheet1")
      .Cells.Delete
      With .Range("A1")
         For i = 1 To CRH
            k = Int(CRH * Rnd())
            With .Offset(i)
               .Value = .Offset(k).Address(False, False)
            End With
         Next
      End With
   End With
   Application.ScreenUpdating = True
End Sub

  • 質問者

    xhx********さん

    2017/10/2913:03:53

    すごい!内容もわかりやすくとても勉強になりました!

    後学のために教えていただきたい部分があるのですが、
    Sheet2のリストを配列に入れる際に、
    For i = 1 To UBound(vA) ではなく 
    For i = UBound(vA) To 1 Step -1
    と記述する理由と
    Set dic = Nothing
    を記述する理由を教えていただけると助かります。

  • その他の返信(3件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2017/10/29 20:14:53

大変勉強になりました。
今後活用できる知識が多く身につきました。
ありがとうございました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

tai********さん

リクエストマッチ

2017/10/2913:25:50

数式でもVLOOKUP関数はかなり高速だと思います。
そのコードで4万行でテストするとCPUにもよるのでしょうが、20秒~30秒ほどで終わります。配列に入れてもそれほど変わらないですね。30秒以上かかるならほかに問題があるのかもしれません。

それにしてもkiku30246さんの配列+Dictionaryは断トツの速さですね。1秒かかっていない感じです。これほどとは・・・

プロフィール画像

カテゴリマスター

tra********さん

2017/10/2815:42:39

初級者に解りやすい、1次元配列を使った例です。

Sub sample()
Dim xAry1a, xAry1b, xAry2a, xAry2b
Dim i As Long, ii, APP
Set APP = Application
With Worksheets("Sheet2")
With .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
xAry2a = APP.Transpose(.Value)
xAry2b = APP.Transpose(.Offset(, 1).Value)
End With
End With
With Worksheets("Sheet1")
With .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).Offset(, 1)
xAry1a = APP.Transpose(.Offset(, -1).Value)
ReDim xAry1b(LBound(xAry1a) To UBound(xAry1a))
For i = LBound(xAry1a) To UBound(xAry1a)
ii = APP.Match(xAry1a(i), xAry2a, 0)
If Not IsError(ii) Then
xAry1b(i) = xAry2b(ii)
End If
Next i
.Value = APP.Transpose(xAry1b)
End With
End With
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる