行番号Collectionで高速化できるか検証

2023年7月23日

条件

・Sheet1に株価情報のテーブルがあり、1列目に証券コード、4列目に市場名がある
・株価情報テーブルのレコード数は3832件ある
・Sheet2には証券コードが473件ある
・Sheet2の証券コードに対して、Sheet1から市場名を取得したい
（ワークシート関数ならVLOOKUPで簡単に取得できる）

時間計測用の関数

Sub MeasureFunctionSpeed()
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsedTime As Double
    
    ' 処理時間計測の開始
    startTime = Timer
    
    ' 測定したい関数を呼び出す
    Call collectiontest
    
    ' 処理時間計測の終了
    endTime = Timer
    elapsedTime = endTime - startTime
    
    ' 結果を表示
    Debug.Print "処理時間: " & Round(elapsedTime, 2) & "秒"
End Sub

Forループで行番号を探す場合（Collection無し）

Sub speedtest()

    '検索対象3832行から一致する行を探して市場名を取得する
    Dim i As Long, j As Long
    For i = 1 To 473
        For j = 1 To 3832
            If Sheet1.Cells(j, 1).Value = Sheet2.Cells(i, 1).Value Then
                Sheet2.Cells(i, 2).Value = Sheet1.Cells(j, 4).Value
                Exit For
            End If
        Next j
    Next i

End Sub

計測結果

1回目：6.89秒
2回目：6.63秒
3回目：6.64秒

Collectionで行番号を取得する場合

Sub collectiontest()
    '行番号Collectionの作成
    Dim kabu As Collection: Set kabu = New Collection
    Dim arr: arr = Sheet1.Range("A1").CurrentRegion
    Dim i As Long
    For i = 2 To UBound(arr)
        kabu.Add i, CStr(arr(i, 1)) '値が行番号、キーが証券コードになる
    Next i
    Erase arr
    
    'Collectionのキーで行番号を取得する
    Dim tmp As Long
    For i = 1 To 473
        tmp = Sheet2.Cells(i, 1).Value
        tmp = kabu.Item(CStr(tmp))
        Sheet2.Cells(i, 2).Value = Sheet1.Cells(tmp, 4).Value
    Next i
End Sub

計測結果

1回目：0.07秒
2回目：0.06秒
3回目：0.08秒

6秒も節約できるじゃないか

さらに出力を配列変数にした場合

Sub collectiontest()
    '行番号Collectionの作成
    Dim kabu As Collection: Set kabu = New Collection
    Dim arr: arr = Sheet1.Range("A1").CurrentRegion
    Dim i As Long
    For i = 2 To UBound(arr)
        kabu.Add i, CStr(arr(i, 1)) '値が行番号、キーが証券コードになる
    Next i
    Erase arr
    
    ReDim arr(1 To 473, 1 To 1)
    Dim tmp As Long
    For i = 1 To 473
        tmp = Sheet2.Cells(i, 1).Value
        tmp = kabu.Item(CStr(tmp))
        arr(i, 1) = Sheet1.Cells(tmp, 4).Value
    Next i
    
    Sheet2.Range("B1").Resize(UBound(arr)) = arr
    
End Sub

計測結果

1回目：0.05秒
2回目：0.04秒
3回目：0.04秒

一見あんま減ってないじゃんと思うが、この検証ではSheet2のレコード数が473件しかない
これが1000件以上とかあるなら処理速度の差はもっと広がると思われる

結論：行番号Collectionは高速化に大変役立つ

worksheetfunctionとの比較

田中氏の動画：https://www.youtube.com/watch?v=gqcMa0Q17K0
において「連想配列よりワークシートの方が速い」的な発言があるので検証

Sub main()
    On Error GoTo err
    Dim ws As Worksheet: Set ws = Sheet2
    Dim wf As WorksheetFunction: Set wf = WorksheetFunction
    
    Dim i As Long
    For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ws.Cells(i, 2) = wf.XLookup(ws.Cells(i, 1), Sheet1.columns(1), Sheet1.columns(4))
    Next i
    
    Exit Sub
err:
    MsgBox "hello"
End Sub

処理時間: 0.37秒
処理時間: 0.34秒
処理時間: 0.34秒

出力に配列を使った場合

Sub main()
    On Error GoTo err

    Dim ws As Worksheet: Set ws = Sheet2
    Dim wf As WorksheetFunction: Set wf = WorksheetFunction

    Dim i As Long, arr() As Variant
    For i = 1 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ReDim Preserve arr(1 To i)
        arr(i) = wf.XLookup(ws.Cells(i, 1), Sheet1.columns(1), Sheet1.columns(4))
    Next i
    
    ws.Range("B1").Resize(UBound(arr)) = wf.Transpose(arr)
    
    Exit Sub
err:
    MsgBox "hello"
End Sub

処理時間: 0.11秒
処理時間: 0.12秒
処理時間: 0.12秒

再度Collectionで検証すると

Sub collectiontest()
    '行番号Collectionの作成
    Dim kabu As Collection: Set kabu = New Collection
    Dim arr: arr = Sheet1.Range("A1").CurrentRegion
    Dim i As Long
    For i = 2 To UBound(arr)
        kabu.Add i, CStr(arr(i, 1)) '値が行番号、キーが証券コードになる
    Next i
    Erase arr
    
    'Collectionのキーで行番号を取得する
    Dim tmp As Long
    For i = 1 To 473
        tmp = Sheet2.Cells(i, 1).Value
        tmp = kabu.Item(CStr(tmp))
        Sheet2.Cells(i, 2).Value = Sheet1.Cells(tmp, 2).Value
    Next i
End Sub

処理時間: 0.06秒
処理時間: 0.05秒
処理時間: 0.06秒

出力を配列にした場合

Sub collectiontest()
    '行番号Collectionの作成
    Dim kabu As Collection: Set kabu = New Collection
    Dim arr: arr = Sheet1.Range("A1").CurrentRegion
    Dim i As Long
    For i = 2 To UBound(arr)
        kabu.Add i, CStr(arr(i, 1)) '値が行番号、キーが証券コードになる
    Next i
    Erase arr
    
    'Collectionのキーで行番号を取得する
    Dim tmp As Long
    For i = 1 To 473
        tmp = Sheet2.Cells(i, 1).Value
        tmp = kabu.Item(CStr(tmp))
        ReDim Preserve arr(1 To i)
        arr(i) = Sheet1.Cells(tmp, 4).Value
    Next i
    
    Sheet2.Range("B1").Resize(UBound(arr)) = WorksheetFunction.Transpose(arr)
End Sub

処理時間: 0.05秒
処理時間: 0.04秒
処理時間: 0.04秒

結論：連想配列（Collection）の方が速い