配列を使用しているのにForループより処理速度が遅い理由

Question

以前より皆様の投稿を拝見しており、勉強させていただいております。
ありがとうございます。

早速ですが、初めて質問させていただきます。

最初はFor文を使った処理を行っていたものの、
処理時間が遅いことや配列を使用した処理の方が速くなることを知ったため、
配列を使用した処理を検討しています。

データ量：1万行以上
検索値：文字列&日付
配列Key:文字列&日付
配列Item:Arrayで配列格納

現状としてFor文処理の場合、8-10分程度の処理時間が掛かっており、
理想としては1分以内に処理が完了するように対応を行いたいと考えています。

こちらのサイトで
過去の投稿含め、参考にしつつ配列のコードを繰り返し作成したのですが、
なぜかFor文より処理が遅くなってしまいます。

配列を使用したらなんでもかんでも早くなるというわけではなく、
For文を使った方が早いパターンもあるということでしょうか...?

以下にコードを記載しますので、
改善点や他により早く処理を行う方法ありましたら、
ご教示頂けると大変助かります。

Sub 一致転記()

Dim ST As Single, ET As Single

Dim wb As Workbook
Set wb = ThisWorkbook

Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = wb.Sheets("sheets1")
Set ws2 = wb.Sheets("sheets2")


Dim j, k, x
Dim lRow1 As Long, lRow2 As Long

Dim list As String
Dim Arry As Object

Set Arry = CreateObject("Scripting.Dictionary")

lRow1 = ws1.Cells(Rows.count, "B").End(xlUp).Row
lRow2 = ws2.Cells(Rows.count, "B").End(xlUp).Row

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ST = Timer

With ws2
For j = 2 To lRow2

    list = .Cells(j, "G") & .Cells(j, "W")
    
    ARY.Add list, Array(.Cells(j, "Y"), .Cells(j, "Z"), .Cells(j, "AA"), .Cells(j, "AB"))

Next j
End With

Dim str, aKey, aItem

With ws1
For k = 3 To lRow1
  str = .Cells(k, "B") & .Cells(k, "C")
    
    For x = 0 To Arry.count - 1
        aKey = Arry.Keys()(x)
        aItem = Arry.Items()(x)
        
            If str = dcKey Then
                
                .Cells(k, "E") = aItem(0)
            
            End If
    
    Next x
    
Next k

ET = Timer
ET = ET - ST

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox Round(ET / 60, 0) & "." & Round(ET Mod 60, 0)

End Sub

Answer 1

まず

Arry.Add list, Array(.Cells(j, "Y"), .Cells(j, "Z"), .Cells(j, "AA"), .Cells(j, "AB"))

ですが，これだとRangeオブジェクトのまま操作していることになります。

Arry.Add list, Array(.Cells(j, "Y").value, .Cells(j, "Z").value, .Cells(j, "AA").value, .Cells(j, "AB").value)

とすることで値での処理になります。

まぁ。これ自体は、今回の処理の遅さにはそれほど影響しないと思います。

With ws1
For k = 3 To lRow1
  str = .Cells(k, "B") & .Cells(k, "C")

    For x = 0 To Arry.count - 1
        aKey = Arry.Keys()(x)
        aItem = Arry.Items()(x)

            If str = dcKey Then

                .Cells(k, "E") = aItem(0)

            End If

    Next x

Next k

こちらの方は、二つ問題があります。
一つ目の問題は、辞書。Dictionaryを使っているのに、検索を自前で行っていること
検索をDictionaryに任せると以下のようになります。

With ws1
For k = 3 To lRow1
    str = .Cells(k, "B") & .Cells(k, "C")
    If Arry.Exists(str) Then
        .Cells(k, "E") = Arry.Item(str)(0)
    End If
Next k
End With

これである程度早くなります。

次に、ヒットしない場合の動作が変わってしまって良ければですが

With ws1
Dim tV As Variant
ReDim tV(3 To lRow1, 0)
For k = 3 To lRow1
    str = .Cells(k, "B") & .Cells(k, "C")
    If Arry.Exists(str) Then
         tV(k,0) = Arry.Item(str)(0)
    End If
Next k
.Range("E3:E" & lRow1).Value = tV
End With

このように配列で一括で、セルにセットすることでもある程度早くなります。
ヒットしない場合の動作を変えたくなければ

With ws1
Dim tV As Variant
tV = .Range("E3:E" & lRow1).Value
For k = 3 To lRow1
    str = .Cells(k, "B") & .Cells(k, "C")
    If Arry.Exists(str) Then
         tV(k - 2, 1) = Arry.Item(str)(0)
    End If
Next k
.Range("E3:E" & lRow1).Value = tV
End With

となるでしょう。
何が違うかと言えば、ヒットしなかったとき、値をそのままにしている。という点です。
用途によって使い分けるといいかと思います。

以上で、処理速度に関しては、早くなるかと思います。

（補足）
（１）
処理速度とは関係ありませんが
Dim str
というのは、str関数を上書きしてしまう（str関数が使いにくくなる）ので使わない方が良いと思います。

（２）
Arryの値を配列で持っていますが一つ目の値しか使っていないですよね。
これは、想定通りなのでしょうか。
想定通りであるのであれば、良いのですが。

（３）
質問文では

ARY.Add list, Array(.Cells(j, "Y"), .Cells(j, "Z"), .Cells(j, "AA"), .Cells(j, "AB"))

となってますが

Arry.Add list, Array(.Cells(j, "Y"), .Cells(j, "Z"), .Cells(j, "AA"), .Cells(j, "AB"))

の記述ミスですよね。

（４）
Arry.Add list, Array(.Cells(j, "Y"), .Cells(j, "Z"), .Cells(j, "AA"), .Cells(j, "AB"))

とありましたがよく見ると連続するセルですね。
この為

Arry.Add list, .Range("Y" & j & ":AB" & j).value

とした方が若干早いかもですね。
こちらの場合にすると処理の書き方が変わるので変えた内容も記載しておきます。

With ws2
For j = 2 To lRow2
    list = .Cells(j, "G") & .Cells(j, "W")
    Arry.Add list, .Range("Y" & j & ":AB" & j).Value
Next j
End With

Dim str, aKey, aItem

With ws1
Dim tV As Variant
ReDim tV(3 To lRow1, 0)
For k = 3 To lRow1
    str = .Cells(k, "B") & .Cells(k, "C")
    If Arry.Exists(str) Then
         tV(k, 0) = Arry.Item(str)(1, 1)
    End If
Next k
.Range("E3:E" & lRow1).Value = tV
End With

Comments

[quark87139]

xail2222様

丁寧でなおかつ分かりやすいご回答ありがとうございます。
配列自体は作成できているものの、配列を活用できていない状態＝
単に1つずつ代入して転記させるＦor文の処理と変わりになかったのですね・・・。
またExistsの部分もネット上で検索して自分なりの解釈でいくと
登録を行う時に利用するもので、検索、取り出し、取り入れに使用するものではないと
意味を取り違っておりました。

補足の点について
1.仰るとおり、str関数があるから変数として使うのはあまり好ましくないですね、
　今後は関数と被らないよう意識してコード作成したいと思います。
2.質問内のコードでは単一のデータを取得転記させる目的として書かれていますが、
　実際に行いたい処理は複数のデータを取得転記させる予定なのでArrayを採用した次第です。
3.仰るように僕のミスです。正しくはArry(create object)です。
4.連続する・しないの違いで使い分けることで処理速度が少し異なるのは知りませんでした。
　今後はその辺も含めて意識しながら作成したいと思います。

以上を踏まえていくつか気になったのですが、
登録済の配列にあるitemをとある表（マスタ）一致検索して取り替えることは可能なのでしょうか？
感覚としては、配列を2回行うイメージで少し手間が掛かる印象なのですが、、、。
1.itemとして格納される分を配列登録
2.一致したものをあるセルへ転記
3.配列登録
4.一致転記

[xail2222]

>登録済の配列にあるitemをとある表（マスタ）一致検索して取り替えることは可能なのでしょうか？
それは可能です。
Arry.Item(str)=???
の形で取り換える事ができますが、こういうことでしょうか。

＞感覚としては、配列を2回行うイメージで少し手間が掛かる印象なのですが、、、。

…ちょっと意味が分からないです。すみません。

[quark87139]

分かりづらい説明ですみません。
配列を2回行うイメージというのは
下記のような手順で考えていたためです。
配列に格納(1回目の格納)されているitemを転記を行い、
転記させた内容(item)を配列に格納(2回目の格納)を行って一致検索・itemの上書きを行う。

より簡潔に言えば、itemをどこかに出力させてから一致検索・転記と2度手間を
掛けずとも1回で完結できるか知りたかった次第です。

[xail2222]

各単語が何を指しているのか解らないです。
何となくでも良いので具体的なコードにして頂ければ簡略化したコードもわかるかもしれません

[quark87139]

具体的なコードとなると以下のような感じになると思うのですが、
意図伝わりますでしょうか...。
※簡略化できず申し訳ございません。

Dim sRow1
Set ws1 = wb.Sheets("出力")
Set ws2 = wb.Sheets("データ元")
Set ws3 = wb.Sheets("マスタ")

sRow1 = ws1.Cells(Rows.count, "B").End(xlUp).Row
sRow2 = ws2.Cells(Rows.count, "B").End(xlUp).Row
sRow3 = ws3.Cells(Rows.count, "B").End(xlUp).Row

'①マスタの内容を配列格納
With ws3
For i = 3 To sRow3
list = .Cells(i, "B")
dc.Add list, .Cells(i, "F")
Next i
End With

'マスタと一致する内容(item)を転記
With ws2
For k = 2 To sRow2
fnd = .Cells(i, "B") & .Cells(i, "D")
If dc.exists(fnd) Then
.Cells(k, "N") = dc.Item(fnd)
End If
Next k
dc.RemoveAll
'②データ元を配列格納
For i = 2 To sRow2
list = .Cells(i, "B") & .Cells(i, "D")
dc.Add list, .Cells(i, "N").Value
Next i
End With

'③転記先シートへ転記
With ws1
For k = 3 To sRow1
fnd = .Cells(k, "B") & .Cells(k, "C")
If dc.exists(fnd) Then
.Cells(k, "F") = dc.Item(fnd)
End If
Next k
End With

[xail2222]

dc.RemoveAllしてから、また追加であれば、確かに二度手間な感じがしますね。

セルへの入出力は、配列を使った方が早いですが
とりあえず辞書 Dicrionaryの扱いの部分だけ記載します。

マスタと一致する内容(item)を転記の部分ですが
現状のソースが実行できるデータ内容であれば

'マスタと一致する内容(item)を転記等
With ws2
For k = 2 To sRow2
fnd = .Cells(i, "B") & .Cells(i, "D")
If dc.exists(fnd) Then
.Cells(k, "N") = dc.Item(fnd)
Else
'マスタ登録外のデータを登録
dc.Add fnd, .Cells(k, "N").Value
End If
Next k
End With

という感じになるでしょうか。

全データが、マスタに登録されているのであれば
再登録は不要になるのですが、マスタ未登録のデータがあると仮定すると
上記のように、登録外のデータだけ追加ということになりますね。

[quark87139]

考えとしては、
マスタと一致する内容をわざわざ転記せず(見える化)に配列上?で
処理を行って転記を行いたいということ
なのですが、
結論としてはマスタと一致する内容転記させてから転記・・・の流れが
考え方としては間違っていないということですかね..?

一旦最初に質問させて頂いた内容自体は解決しているので、
解決済とさせて頂きます。
お忙しい中時間を割いていただきありがとうございました。

[xail2222]

＞考え方としては間違っていないということですかね..?

ん～。マスタは、その命名で意味は分かります。
データ元の役割が、意味が良くわかりません。

この為、間違っているかどうかよくわからないです。

Answer 2

＜追記＞

Sub 一致転記2()

    '開始時間
    Dim ST As Single, ET As Single
    ST = Timer
    
    '表示抑制
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    '配列作成
    Dim ws1rng As Range, ws1data As Variant
    With ThisWorkbook.Sheets("出力")
        Set ws1rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        ws1data = ws1rng.Value
    End With
    Dim ws2rng As Range, ws2data As Variant
    With ThisWorkbook.Sheets("データ元")
        Set ws2rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        ws2data = ws2rng.Value
    End With
    Dim ws3rng As Range, ws3data As Variant
    With ThisWorkbook.Sheets("マスタ")
        Set ws3rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        ws3data = ws3rng.Value
    End With
    
    '辞書作成
    Dim m, i, k, v
    Set m = CreateObject("Scripting.Dictionary")
    For i = 3 To UBound(ws3data, 1)
        k = ws3data(i, 2)
        v = ws3data(i, 6)
        m(k) = v
    Next
    
    '辞書適用
    Dim d
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(ws2data, 1)
        k = ws2data(i, 2) & ws2data(i, 4)
        If m.Exists(k) Then
            ws2data(i, 14) = m(k)
            d(k) = ws2data(i, 14)
        End If
    Next
    For i = 2 To UBound(ws1data, 1)
        k = ws1data(i, 2) & ws1data(i, 3)
        If d.Exists(k) Then
            ws1data(i, 6) = d(k)
        End If
    Next
        
    '配列出力
    ws1rng.Value = ws1data
    ws2rng.Value = ws2data

    '抑制解除
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    '終了時間
    ET = Timer - ST
    MsgBox Round(ET / 60, 0) & "." & Round(ET Mod 60, 0)

End Sub

---

＜追記前＞
他の方とそんなに変わらないので載せる意味も乏しいですが。

Sub 一致転記()

    '開始時間
    Dim ST As Single, ET As Single
    ST = Timer
    
    '表示抑制
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    '配列作成
    Dim ws1rng As Range, ws1data As Variant
    With ThisWorkbook.Sheets("sheets1")
        Set ws1rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        ws1data = ws1rng.Value
    End With
    Dim ws2rng As Range, ws2data As Variant
    With ThisWorkbook.Sheets("sheets2")
        Set ws2rng = .Range("A1", .Cells.SpecialCells(xlCellTypeLastCell))
        ws2data = ws2rng.Value
    End With
    
    '辞書作成
    Dim d, i, k, v
    Set d = CreateObject("Scripting.Dictionary")
    For i = 3 To UBound(ws2data, 1)
        k = ws2data(i, 7) & ws2data(i, 23)
        v = Array(ws2data(i, 25), ws2data(i, 26), ws2data(i, 27), ws2data(i, 28))
        d(k) = v
    Next
    
    '辞書適用
    For i = 3 To UBound(ws1data, 1)
        k = ws1data(i, 2) & ws1data(i, 3)
        If d.Exists(k) Then ws1data(i, 5) = d(k)(0)
    Next
    
    '配列出力
    ws1rng.Value = ws1data

    '抑制解除
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    '終了時間
    ET = Timer - ST
    MsgBox Round(ET / 60, 0) & "." & Round(ET Mod 60, 0)

End Sub

Answer 3

Xail2222様の回答と被る部分がありますが、、、、

エクセルのVBAで遅くなる原因は、セルを一つずつ参照、更新することです。
また、２重ループも件数が多いと遅くなります。

今回のコードでの重い処理は、主に下記の三つです。

1. セルを一つずつ参照している。
2. セルを一つずつ更新している。
3. 2重ループで検索している。

高速化対策としてそれぞれに下記になります。

1. セル範囲を配列に格納して配列を参照する。
2. 配列を更新して、更新した配列をセル範囲に一気に代入する。
3. 連想配列(Dictionary)で検索する。

上記の方針で質問のコードを書き換えると下記のようになります。

Sub 一致転記()

    Dim ST As Single, ET As Single

    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = wb.Sheets("sheet1")
    Set ws2 = wb.Sheets("sheet2")


    Dim lRow1 As Long, lRow2 As Long

    Dim Dic As Object

    Set Dic = CreateObject("Scripting.Dictionary")

    lRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    lRow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ST = Timer

    '検索値の文字列、日付、また、転記データをそれぞれ配列に格納
    With ws2
        Dim aryStr, aryDate, aryValue
        aryStr = .Cells(2, "G").Resize(lRow2 - 1).Value
        aryDate = .Cells(2, "W").Resize(lRow2 - 1).Value
        aryValue = .Cells(2, "Y").Resize(lRow2 - 1, 4).Value
    End With

    'Dictionaryに検索値(key)と転記データ(Item)を格納
    Dim j As Long
    For j = 1 To UBound(aryStr)
        Dic.Add aryStr(j, 1) & aryDate(j, 1), Array(aryValue(j, 1), aryValue(j, 2), aryValue(j, 3), aryValue(j, 4))
    Next j


    '転記先の検索値とセル範囲を配列にそれぞれ格納
    Dim aryKey1, aryValue1, rngValue1 As Range
    aryKey1 = ws1.Cells(3, "B").Resize(lRow1 - 2, 2).Value
    Set rngValue1 = ws1.Cells(3, "E").Resize(lRow1 - 2, 4) '転記先セル範囲
    aryValue1 = rngValue1.Value

    
    Dim k As Long, Key As String
    For k = 1 To UBound(aryKey1)
        'Dictionaryを検索して一致したら、対応する配列データを更新
        Key = aryKey1(k, 1) & aryKey1(k, 2)
        If Dic.Exists(Key) Then

            aryValue1(k, 1) = Dic.Item(Key)(0)
            aryValue1(k, 2) = Dic.Item(Key)(1)
            aryValue1(k, 3) = Dic.Item(Key)(2)
            aryValue1(k, 4) = Dic.Item(Key)(3)

        End If
    Next k
    
    '更新した配列をセル範囲に代入
    rngValue1.Value = aryValue1
    

    ET = Timer
    ET = ET - ST

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox Round(ET / 60, 0) & "." & Round(ET Mod 60, 0)

End Sub

複数列をどのように転記するか不明なので、とりあえず、
Y列からAB列までをsheet1のE列以降に代入するようにしています。

Answer 4

配列の速さについての基本的なことは、こちらの解説がわかりやすいとおもいます。
http://officetanaka.net/excel/vba/speed/s11.htm

Xail2222様も言うとおり、セルへの代入を一個ずつやっていたら配列使っても大して変わらないということですね。一括で代入することで一気に速くなります。