表データを操作する５つの方法を体感してみた

Excelと言えば表である。

VBAから表のデータをまとめて操作する方法としては配列が挙げられる。
ところが最近空のRecordsetを使用する方法があることを知って勉強しようと思った矢先に、ArrayListなる機能もあると知ってなにがどう違ってどう良いんだ～となったので自分なりに使って体感することにした。

５つの方法

他にあるとは思うが今回自分が体感してみようと思うのは以下の５つです。

• 配列
• Collection
• Dictionary
• Recordset
• ArrayList

今回はシートのデータを５つの機能に取り込み、そのまま別のシートに貼り付ける作業を、それぞれの機能で実現してみます。
取り込むデータは１０万行×６列のデータです。

時間計測関数

今回記事中のコードには下記の関数で処理時間を計測しています。

Dim CheckTime As Double
Function CheckTimePrintOut(Message As String, Optional StartTime As Double = 0) As String
     Debug.Print Message & Timer - IIf(StartTime = 0, CheckTime, StartTime)
     CheckTime = Timer
End Function

初回は第２引数にTimer関数で計測開始時間を渡しています。
２回目以降に呼び出すときは前回計測した時間を記憶していますので、呼び出すだけで前回からの経過時間を返します。

各機能コード

最初に記載しましたがシートにあるデータを各機能に取り込み、別シートに単純に貼り付けるコードです。

狙いとしては各機能での書き心地と処理速度を感じるためにやっています。

配列

Sub 単純貼付け_配列()
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
     CheckTimePrintOut "配列：データ取り込み開始：", Timer
'配列取込開始-----------------------------------------
     Dim myArray As Variant: myArray = Worksheets("Sheet1").Range("A1").CurrentRegion
     CheckTimePrintOut "データ取り込み終了："
'データ貼付け-----------------------------------------
     Worksheets("Sheet2").Range("A1").Resize(UBound(myArray) + 1, UBound(myArray, 2)).Value = myArray
     CheckTimePrintOut "データ貼り付け終了："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub

Collection

Sub 単純貼付け_Collection()
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
     CheckTimePrintOut "Collection：データ取り込み開始：", Timer
'Collection取込開始-----------------------------------------
     Dim myCol As Collection: Set myCol = New Collection
     Dim myRngs As Range: Set myRngs = Worksheets("Sheet1").Range("A1").CurrentRegion
     Dim myRng As Range
     For Each myRng In Intersect(myRngs, Worksheets("Sheet1").Range("A:A"))
          myCol.Add myRng.Resize(1, myRngs.Columns.Count).Value
     Next
     CheckTimePrintOut "データ取り込み終了："
'データ貼付け-----------------------------------------
     Dim col As Variant
     Dim i As Long
     Dim myData As Variant: ReDim myData(myCol.Count, 6)
     For Each col In myCol
          Dim n As Long
          For n = 1 To 6
               myData(i, n - 1) = col(1, n)
          Next
          i = i + 1
     Next
     Worksheets("Sheet2").Range("A1").Resize(UBound(myData) + 1, UBound(myData, 2) + 1).Value = myData
     CheckTimePrintOut "データ貼り付け終了："
'クロージング-----------------------------------------
     Set myCol = Nothing
     CheckTimePrintOut "クロージング："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub

Dictionary

Sub 単純貼付け_Dictionary()
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
     CheckTimePrintOut "Dictionary：データ取り込み開始：", Timer
'Dictionary取込開始-----------------------------------------
     Dim myDic As Dictionary: Set myDic = New Dictionary 'Microsoft Scripting Runtime参照設定が必要
     Dim myRngs As Range: Set myRngs = Worksheets("Sheet1").Range("A1").CurrentRegion
     Dim myRng As Range
     For Each myRng In Intersect(myRngs, Worksheets("Sheet1").Range("A:A"))
          myDic.Add Left(myRng.Value, 1) & Format(myRng.Row, "00000"), myRng.Resize(1, myRngs.Columns.Count).Value
     Next
     CheckTimePrintOut "データ取り込み終了："
'データ貼付け-----------------------------------------
     Dim dic As Variant
     Dim i As Long
     Dim n As Long
     Dim myData As Variant: ReDim myData(myDic.Count, 6)
     For Each dic In myDic
          For n = 1 To 6
               myData(i, n - 1) = myDic(dic)(1, n)
          Next
          i = i + 1
     Next
     Worksheets("Sheet2").Range("A1").Resize(UBound(myData) + 1, UBound(myData, 2) + 1).Value = myData
     CheckTimePrintOut "データ貼り付け終了："
'クロージング-----------------------------------------
     Set myDic = Nothing
     CheckTimePrintOut "クロージング："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub

Recordset

Sub 単純貼付け_空Recrodset()
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
     CheckTimePrintOut "Recordset：データ取り込み開始：", Timer
'空のRecordset作成-----------------------------------------
     Dim myRS As ADODB.Recordset
     Set myRS = New ADODB.Recordset
     With myRS.Fields
          .Append "名前", adVarWChar, -1
          .Append "ふりがな", adVarWChar, -1
          .Append "アドレス", adVarWChar, -1
          .Append "性別", adVarWChar, -1
          .Append "年齢", adInteger
          .Append "誕生日", adDate
     End With
     myRS.Open
'Recordsetデータ取り込み-----------------------------------------
     CheckTimePrintOut "データ取り込み開始："
     Dim myListObj As ListObject: Set myListObj = Worksheets("Sheet1").ListObjects("t_個人情報")
     Dim i As Long
     Dim n As Long
     Dim ColumnName As Variant
     
     Dim myRngs As Range: Set myRngs = Worksheets("Sheet1").Range("A1").CurrentRegion
     Dim myRng As Range
     Dim FieldList As Variant: FieldList = Array("名前", "ふりがな", "アドレス", "性別", "年齢", "誕生日")
     Dim ValueList As Variant
     For Each myRng In Intersect(myRngs, Worksheets("Sheet1").Range("A2:A" & Rows.Count))
          myRS.AddNew FieldList, DownDimension(myRng.Resize(1, myRngs.Columns.Count).Value)
     Next

     myRS.MoveFirst
     CheckTimePrintOut "データ取り込み終了："
'データ貼り付け-----------------------------------------
     Dim myWS As Worksheet: Set myWS = Worksheets("Sheet2")
     For i = 1 To myRS.Fields.Count
          myWS.Cells(1, i).Value = myRS.Fields(i - 1).Name
     Next
     myWS.Range("A2").CopyFromRecordset myRS
     myRS.MoveFirst
     CheckTimePrintOut "データ貼り付け終了："
'クロージング-----------------------------------------
     myRS.Close
     Set myRS = Nothing
     
     CheckTimePrintOut "クロージング："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub


Function DownDimension(二次元配列 As Variant) As Variant
     Dim myVar As Variant
     Dim i As Long
     ReDim myVar(0 To UBound(二次元配列, 2) - 1)
     For i = 0 To UBound(myVar)
          myVar(i) = 二次元配列(1, i + 1)
     Next
     DownDimension = myVar
End Function

ArrayList

Sub 単純貼付け_ArrayList()
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
     CheckTimePrintOut "ArrayList：データ取り込み開始：", Timer
'ArrayListデータ取り込み-----------------------------------------
     Dim myList As Object: Set myList = CreateObject("System.Collections.ArrayList")
     Dim myRngs As Range: Set myRngs = Worksheets("Sheet1").Range("A1").CurrentRegion
     Dim myRng As Range
     For Each myRng In Intersect(myRngs, Worksheets("Sheet1").Range("A:A"))
          myList.Add myRng.Resize(1, myRngs.Columns.Count).Value
     Next
     CheckTimePrintOut "データ取り込み終了："
'データ貼り付け-----------------------------------------
     Dim Var As Variant
     Dim i As Long
     Dim n As Long
     Dim myData As Variant: ReDim myData(myList.Count, 6)
     For Each Var In myList
          For n = 1 To 6
               myData(i, n - 1) = Var(1, n)
          Next
          i = i + 1
     Next
     Worksheets("Sheet2").Range("A1").Resize(UBound(myData), UBound(myData, 2)).Value = myData
     CheckTimePrintOut "データ貼り付け終了："
'クロージング-----------------------------------------
     Set myList = Nothing
     CheckTimePrintOut "クロージング："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub

処理時間

処理時間についてはコードの良し悪しでかなり変わってくる。
そのため機能の差とは必ずしも言えないが参考までに。

機能	配列	Collection	Dictionary	Recordset	ArrayList
データ取り込み	0.074	0.773	2.015	2.171	2.046
データ貼り付け	3.101	3.464	5.316	0.710	3.812
全処理時間	3.183	4.292	7.402	2.929	5.863

個人的に今気になっているRecordsetが配列を差し置いて最速の結果に。

試してみた感想

冒頭にも記載したが、今回はシートにあるデータを丸ごとそれぞれの機能に取り込んで、そのまま別のシートに転記するコードを試した。
このぐらいの作業では配列・Recordset以外はメリットより準備に手間取る・処理速度が遅いぐらいのデメリットしか感じないですが。

配列

• 慣れているので悩まずにコードを書ける
• 処理が速い

Collection

• 配列と同じように参照設定は不要

Dictionary

• 参照設定が必要
• Collectionと違ってKeyが必須
• 中身のデータ(Item)がウォッチウィンドウでないと確認できない
• 遅い

Recordset

• 参照設定が必要
• 列毎の型設定が必要
• 列の型設定があるため、違う型のデータが混ざっているとエラーになる
• 配列並みに速い

ArrayList

• 参照設定が必要
• 入力補完が効かない
• ToArrayメソッドの返り値がジャグ配列なのでセルに直接貼り付けられない
• 遅い

まとめ

それぞれの機能の良し悪しと言うよりは、まだ処理速度の差ぐらいしか見えていません。 次はデータの選別を体感してみたいと思っています。