[[20220324095931]]　『VBAのループ処理時間を短縮したい。』（わんだふる）　ページの最後に飛ぶ

『VBAのループ処理時間を短縮したい。』（わんだふる）

リストシートA列の値をキーとして、マスターシートのB列から検索。
（リスト・マスターシートそれぞれでB列の値の重複はありません）
該当があった場合に、マスターシートのAA列にリストシートのB＆C列の値を転記したいです。

自分で思いついたコードを書いてみましたが、
処理時間を計測したところ、約7分かかったためもっと短縮したいです。

インターネットで調べたところ、配列（Dictionary？）でやると早いとありましたが、
初心者のためよくわかりません。
どなたかご教授いただけますでしょうか。

【リストシート】（200行前後あります）
　　　　　A列　　　　B列　　　　C列　
1行目　　11111　　　あいう　　　アイウ
2行目　　22222　　　かきく　　　カキク
3行目　　77777　　　まみむ　　　マミム
　・
　・
　・

【マスタシート】（3000行程ですが、これからもどんどん追加されて増えていく予定です）
　　　　　A列　　　　B列　　　　・・・　　　　AA列
1行目　　aaaaa　　　11111　　　　　　　　　　あいうアイウ
2行目　　bbbbb　　　22222　　　　　　　　　かきくカキク
3行目　　ccccc　　　33333
4行目　　ddddd　　　777777　　　　　　　　　まみむマミム
　・
　・
　・

【記載したコード】

    startTime = Timer

    rowEnd = Sheets("マスター").Cells(Rows.Count, 1).End(xlUp).Row
    rowEnd2 = Sheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To rowEnd
        aaa = Sheets("マスター").Range("B" & i)
        For j = 2 To rowEnd2
            bbb = Sheets("リスト").Range("A" & j)
            If aaa = bbb Then
                Sheets("マスター").Range("AY" & j) = Sheets("リスト").Range("B" & j) & " －  " & Sheets("リスト").Range("C" & j)
                Exit For
            Else
                Sheets("マスター").Range("AY" & j).Clear
            End If
        Next j
    Next i

    endTime = Timer

    MsgBox "処理時間" & vbCrLf & endTime - startTime, vbInformation, "判定完了"

＜使用 Excel：Office365、使用 OS：Windows10 ＞

とりあえず、Application.ScreenUpdating = False　と
Application.ScreenUpdating = True　で括るのがお約束。

（どすん） 2022/03/24(木) 10:39

とりあえず^2　
Sheets("マスター").Range("AY" & j).Clear
をやめる。7分間のかなりの部分がこのために費やされているのでは？
　
（γ） 2022/03/24(木) 10:43

VLOOKUP関数を使用した式を埋め込み、取得してから値貼り付けを行う。
これも今より数段早くなると思います。

（γ） 2022/03/24(木) 10:47

Sub test()

    Dim vntKey As Variant
    Dim vntList As Variant
    Dim vntFind As Variant
    Dim vntResults As Variant   '結果をため込む変数（配列）
    Dim rngResults As Range     '結果を書き込むセル範囲
    Dim v As Variant
    Dim ix As Variant
    Dim i As Long

    With Worksheets("マスター").Range("A1").CurrentRegion
        Set rngResults = .Columns("AY").Cells
        rngResults.ClearContents
        vntResults = WorksheetFunction.Transpose(rngResults.Value)
        vntKey = WorksheetFunction.Transpose(.Columns("B"))
    End With
    vntList = Worksheets("リスト").Range("A1").CurrentRegion
    With WorksheetFunction
        vntFind = .Transpose(.Index(vntList, 0, 1))
    End With

    For i = LBound(vntKey) To UBound(vntKey)
        ix = Application.Match(vntKey(i), vntFind, 0)
        If Not IsError(ix) Then
            vntResults(i) = vntList(ix, 2) & vntList(ix, 3)
        End If
    Next

    rngResults.Value = WorksheetFunction.Transpose(vntResults)
End Sub

個々のセルを読み書きしないようにすると速くなると思います。

（まっつわん） 2022/03/24(木) 10:54

はい、辞書のやつ。
何分になったか気になるね。

Sub testDictionary()

    Dim rowEnd As Long
    Dim rowEnd2 As Long
    Dim i As Long
    Dim dic As Object
    Dim data

    Application.ScreenUpdating = False

    Set dic = CreateObject("Scripting.Dictionary")

    'シートにあるデータを二次元配列に格納
    data = Sheets("リスト").Range("A1").CurrentRegion

    '辞書を作る
    For i = 1 To UBound(data)
        If Not dic.exists(data(i, 1)) Then '重複がないか
            'key itemを追加  ... itemは、B、C列を足した文字列
            dic.Add data(i, 1), data(i, 2) & data(i, 3)
        End If
    Next i

    With Sheets("マスター")

    rowEnd = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To rowEnd
        .Cells(i, "AY") = dic(.Cells(i, "B").Value)

    Next i

    End With

    Application.ScreenUpdating = True

End Sub

（どすん） 2022/03/24(木) 11:37

速度向上策は
1.ワークシートに式が大量にある場合は、一時的に手動計算にするだけで効果が大きい時がある。
2.ワークシート関数の適宜の利用、後で値に変換します。
3.配列利用
（特にワークシート書き込みは、個々に書くより配列で一括書き込みすると効果が大きい。
　読み込みは効果はあるものの、書き込みに比べて効果は小さい）
4.辞書利用
などがありますね。既に皆さんから提示されているものです。

dim t
t = Timer
（処理）
Debug.Print Timer - t
とすれば処理時間が計測されるので、提案について結果を教えてもらうとありがたいですね。

（γ） 2022/03/24(木) 14:34

コメント返信：

[ 一覧(最新更新順) ]

[[20220324095931]] 『VBAのループ処理時間を短縮したい。』（わんだふる） ページの最後に飛ぶ

[[20220324095931]]　『VBAのループ処理時間を短縮したい。』（わんだふる）　ページの最後に飛ぶ