VBA 二次元配列を使ってシートに高速で書き込む

前々回で、従業員データを入力し、前回 で部署ごとに振り分けるというデータ処理を行ったので、ここでは「振り分けた部署ごとのシートにデータを出力する」をしてみたいと思います。

概要

シートに書き込むのは、そのまま単純にセルに書き込んでいく方法でも可能ですが、データ量が多くなると、その都度セルへ値を書き込む回数も増えるため非常に遅くなってしまいます。
そこで各セルに対して書き込むのではなく、二次元配列を用意して、それを貼り付けるようにすれば、シート一枚につき一回の書き込みで済むため、非常に高速に書き込むことが出来ます。

ソースコード

OutputModule.bas

Option Explicit

Private Const EMPLOYEE_ID_COLUMN_NUM As Long = 1                ' IDの行番号
Private Const EMPLOYEE_NAME_COLUMN_NUM As Long = 2              ' 名前の行番号
Private Const EMPLOYEE_DEPARTMENT_COLUMN_NUM As Long = 3        ' 部署の行番号
Private Const MAX_COLUMN_NUM = 3                                ' 列の最大値　この場合、部署の行が最後なのでそれと同じ値となる

' シートにデータを書き込む
' 引数:書き込むシート名, 書き込むデータ
Public Sub WriteData(ByVal sheetName As String, ByVal list As Collection)
    Call ClearSheet(sheetName)      ' シートをクリアにする
    Call WriteHeader(sheetName)     ' 項目名を書き込む
    Call WriteRows(sheetName, list) ' データ一覧を書き込む
End Sub

' シートをクリアにする
' 引数:対象のシート名
Private Sub ClearSheet(ByVal sheetName As String)
    With ThisWorkbook.Worksheets(sheetName)
        .Cells.Clear    ' 全てのセルをクリアする
    End With    
End Sub

' シートにヘッダー項目を書き込む
' 引数:対象のシート名
Private Sub WriteHeader(ByVal sheetName As String)
    With ThisWorkbook.Worksheets(sheetName)
        .Cells(1, EMPLOYEE_ID_COLUMN_NUM) = "ID"
        .Cells(1, EMPLOYEE_NAME_COLUMN_NUM) = "名前"
        .Cells(1, EMPLOYEE_DEPARTMENT_COLUMN_NUM) = "部署"
    End With
End Sub

' 行にデータを書き込む
' 引数:書き込むシート名, 書き込むデータ
Private Sub WriteRows(ByVal sheetName As String, ByVal list As Collection)
    Dim startRowNum As Long ' 開始する行数
    Dim endRowNum As Long   ' 最後の行数
    
    startRowNum = 2         ' 1行目がヘッダーでデータは2行目のため
    endRowNum = startRowNum + list.Count - 1    ' 開始行数 + データ数 - 1が最後の行数
    
    Dim allCellValue() As Variant   ' 様々な型が入るように Variantとする
    allCellValue = ConvertToTwoDimensionalArray(list)   ' データを二次元配列に変換する
    ' データをシートに貼り付ける形で与える          
    With ThisWorkbook.Worksheets(sheetName)
        .Range(.Cells(startRowNum, 1), .Cells(endRowNum, MAX_COLUMN_NUM)) = allCellValue
    End With    
End Sub

' データを二次元配列に変換する
' 引数:変換対象データ
Private Function ConvertToTwoDimensionalArray(ByVal list As Collection) As Variant
    Dim twoArray() As Variant   ' 様々な型が入るように Variantとする
    
    ' （行数, 列数）の2次元配列として設定する。
    ' Rangeのインデックスが1から開始なので、それに合わせて二次元配列も1から開始の方が分かりやすい
    ' ReDim twoArray(list.Count - 1, MAX_COLUMN_NUM - 1) という形でゼロスタートでもできなくはないけど、
    ' 至る所に -1 が入ってきて間違えやすい
    ReDim twoArray(1 To list.Count, 1 To MAX_COLUMN_NUM)
    
    Dim employeeData As EmployeeClass
    Dim num  As Long
    num = 1
    For Each employeeData In list
        twoArray(num, EMPLOYEE_ID_COLUMN_NUM) = employeeData.Id
        twoArray(num, EMPLOYEE_NAME_COLUMN_NUM) = employeeData.name
        twoArray(num, EMPLOYEE_DEPARTMENT_COLUMN_NUM) = employeeData.Department
        num = num + 1
    Next
    ConvertToTwoDimensionalArray = twoArray
End Function

参考：

EmployeeClass.cls

Public Id As String             ' ID
Public Name As String           ' 名前
Public Department  As String    ' 部署

実行例

試しに実行してみます。適当なモジュールで次のようなSubプロシージャを作成します。
"営業部"、"開発部"、"総務部"シートは事前に存在するものとします。（存在しないとエラーになります）

適当なモジュールにて

Sub StartOutputTest()
    Dim employeeList As Collection
    Dim employeeData As EmployeeClass
    Set employeeList = GetAllEmployeeData   ' 従業員データを呼び出す
        
    Dim dic As Dictionary
    Set dic = CreateDepartmentDictionary(employeeList) ' 部署ごとのDictionaryを作成する
    
    Dim salesName As String: salesName = "営業部"
    Dim devName As String: devName = "開発部"
    Dim geneName As String: geneName = "総務部"
        
    Call OutputModule.WriteData(salesName, dic(salesName))  ' 営業部のデータを出力します
    Call OutputModule.WriteData(devName, dic(devName))      ' 開発部のデータを出力します
    Call OutputModule.WriteData(geneName, dic(geneName))    ' 総務部のデータを出力します
End Sub

GetAllEmployeeData() については前々回、CreateDepartmentDictionary()については前回 を参照してください。

実行すると、従業員が部署別にそのシートごとに出力されるのが分かります。

結果例(営業)

今回で示した例では、項目は3つで、レコード数も10と少ないので実感できないと思いますが、項目数10×レコード1000というようにデータ量が多くなってくると実感できると思います。

参考文献

エクセルVBAは2次元配列を使うと高速かつ便利