Excel

クラス - ワークシート高速出力クラス

ワークシートにデータを出力する際、各セルにアクセスしていては時間がかかりすぎるので、バッファ(二次元配列)に出力内容を溜め込んでから一気に出力すれば速くなるのではないかと考えた人、正解です。
それでまあ、私はバッファ入出力処理なんて即興で組めるから備忘録なんていらないし、ましてやクラスを使うなんて考えられないという人はさようなら。今回は、そうでない人のために、バッファ入出力部分をわざわざ組まなくても良いクラスを提供させていただいております。利用例は以下。

    Dim Buffer As SheetBuffer
    Set Buffer = New SheetBuffer

    Buffer.Reset Sheet1, 100, 40

    Dim Row As Long, Column As Long
    For Row = 1 To 1000
        For Column = 1 To 40
            Buffer.Set Row, Col, "Row: " & Row & ", Column: " & Column
        Next
    Next
    Buffer.Commit

上からざっくり眺めていきましょう。

Dim Buffer As SheetBuffer
Set Buffer = New SheetBuffer

まず、SheetBufferオブジェクトのインスタンスを生成します。
何を言っているのか分からないという人もそうでない人も上記コードを書いておけば良いと思います。

Buffer.Reset ActiveSheet, 100, 40

Resetメソッドを実行することで、入出力バッファを初期化しています。
Resetメソッドの引数は左から [入出力対象シート] [行数] [列数] となっています。
このクラスでは、バッファ範囲外に出力するとバッファ領域を再取得する作りになっているので、なるべくバッファ再取得回数が減るように行数と列数を設定してください。
例えば、20列書き込んでから次の行に出力する場合は列数を20以上にしておいた方が良いです。

Buffer.Set Row, Col, "Row: " & Row & ", Column: " & Column

出力処理です。
Setメソッドを実行することで、入出力バッファに任意の値を出力します。
Setメソッドの引数は左から [行] [列] [出力内容] となっています。
入出力バッファ範囲外の入出力を実行したタイミングで、自動的にバッファ内容をワークシートに出力し、新しい範囲のバッファを取得します。

Buffer.Commit

最後にCommitメソッドを実行することで、バッファ内容をワークシートに出力します。
この処理を怠ることで、出力したはずなのにされてない…という歯がゆい思いを楽しむことが出来るようになっています。

説明は以上です。
SheetBufferクラスのコードを以下に記載します。
SheetBufferというクラスを作り、コードをぺたっと貼り付けて活用してください。

Private BufferSheet As Excel.Worksheet
Private Buffer() As Variant
Private BufferRows As Long
Private BufferColumns As Long
Private BufferBeginRow As Long
Private BufferBeginColumn As Long
Private BufferEndRow As Long
Private BufferEndColumn As Long
Private BufferBeginRowS1 As Long
Private BufferBeginColumnS1 As Long
Private EditRows As Long
Private EditColumns As Long

'================================================================================
'   Initialize
'================================================================================
Private Sub Class_Initialize()

    Set BufferSheet = Nothing
    
End Sub

'================================================================================
'   Public Method
'================================================================================
Public Sub Commit()

    If (BufferSheet Is Nothing) Then
        Exit Sub
    Else
        BufferSheet.Cells(BufferBeginRow, BufferBeginColumn).Resize(EditRows, EditColumns) = Buffer
    End If

End Sub

Public Function Get_(ByVal Row As Long, ByVal Column As Long) As Variant

    If (Row < BufferBeginRow Or Row > BufferEndRow Or _
        Column < BufferBeginColumn Or Column > BufferEndColumn) Then
        Call Commit
        Call ResetBuffer(Row, Column)
    End If
    Get_ = Buffer(Row - BufferBeginRowS1, Column - BufferBeginColumnS1)

End Function

Public Sub Set_(ByVal Row As Long, ByVal Column As Long, ByVal Value As Variant)

    If (Row < BufferBeginRow Or Row > BufferEndRow Or _
        Column < BufferBeginColumn Or Column > BufferEndColumn) Then
        Call Commit
        Call ResetBuffer(Row, Column)
    End If
    Buffer(Row - BufferBeginRowS1, Column - BufferBeginColumnS1) = Value

    If (Row - BufferBeginRowS1 > EditRows) Then EditRows = Row - BufferBeginRowS1
    If (Column - BufferBeginColumnS1 > EditColumns) Then EditColumns = Column - BufferBeginColumnS1

End Sub

Public Sub Reset(ByRef XSheet As Excel.Worksheet, ByVal Rows As Long, ByVal Columns As Long)

    If Not (BufferSheet Is Nothing) Then
        Call Commit
    End If
    
    Set BufferSheet = XSheet
    BufferRows = Rows
    BufferColumns = Columns
    
    Call ResetBuffer(1, 1)

End Sub

'================================================================================
'   Private Method
'================================================================================
Public Sub ResetBuffer(ByVal Row As Long, ByVal Column As Long)

    BufferBeginRowS1 = (Row \ BufferRows) * BufferRows
    BufferBeginColumnS1 = (Column \ BufferColumns) * BufferColumns
    BufferBeginRow = BufferBeginRowS1 + 1
    BufferBeginColumn = BufferBeginColumnS1 + 1
    BufferEndRow = BufferBeginRowS1 + BufferRows
    BufferEndColumn = BufferBeginColumnS1 + BufferColumns
    EditRows = 1
    EditColumns = 1
    Buffer = BufferSheet.Range(BufferSheet.Cells(BufferBeginRow, BufferBeginColumn), _
                               BufferSheet.Cells(BufferEndRow, BufferEndColumn))

End Sub