[ExcelVBA] 二次元配列を簡単に操作するClass

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 24日目

データを蓄積してそれを最後にセルに出力するなんてことはあると思うのですが
データ量が増えるとエクセルに出力する部分がえらく時間がかかるようになります
高速で出力するには、配列に格納して出力するのが最速となります。
ただ…
出力する時に行と列をいれかえる必要があったりCollectionならAddするだけで
要素が追加できるとこをいちいち、要素数が存在しない時と存在する時で処理を
分岐して毎回Redim Preserveしなきゃいけないなんてのはめんどくさい以外の
何者でもありません。

そういうのは、裏側でこっそり処理して表側には見えないようにしてあげた方が便利よいですよね。
そんなわけで、セルに出力することに特化させた二次元配列のクラスを作ってみました。

Option Explicit

Dim Data()    As String
Dim x         As Long
Dim y         As Long
Dim DelColumn As Integer

'Setter/Getter
Public Property Let DeleteColumn(ByVal num As Integer)
    DelColumn = num
End Property

Public Property Get DeleteColumn() As Integer
    DeleteColumn = DelColumn
End Property

Private Sub Class_Initialize()

    '初期化
    x = -1
    y = -1

End Sub

Function Count()

    '要素数を返す
    Count = UBound(Data, 2) + 1

End Function

Function Item(ByVal a As Long, ByVal b As Long)
    
    '要素の値を返す
    Item = Data(a, b)
    
End Function

Function Last()

    '最終要素を返す
    Last = UBound(Data, 2)

End Function

Private Function TransposeData()
    Dim s        As Long
    Dim t        As Long
    Dim TPData() As String
    ReDim TPData(y, x)
    
    For s = 0 To y
        For t = 0 To x
            TPData(s, t) = Data(t, s)
        Next
    Next
    
    TransposeData = TPData
End Function

Function Value() As String()

    '２次元配列自体を返す
    Value = Data()

End Function

Sub Add(ByRef list As Variant)
    Dim i As Long
    
    '１次元の要素数が確定していない時、要素数の調査をおこなう
    If x = -1 Then
        
        If TypeName(list) = "Variant()" Then
            
            x = UBound(list)
        
        Else
            
            x = 0
        
        End If
    
    End If
    
    
    '要素数の再定義
    y = y + 1
    ReDim Preserve Data(x, y)
    
    If TypeName(list) = "Variant()" Then
        
        For i = 0 To x
        
            '要素数が足りないときは、空文字を指定
            On Error Resume Next
            Data(i, y) = list(i)
            On Error GoTo 0
        
        Next
        
    Else
    
        Data(x, y) = list
    
    End If

End Sub

Sub Clear()
    Erase Data
    DelColumn = -1
    x = -1
    y = -1
End Sub

Sub Output(ByVal Sht As Worksheet, ByVal Cell As String)
    Dim BaseRow As Long
    Dim BaseCol As Long
    
    BaseRow = Sht.Range(Cell).Row
    BaseCol = Sht.Range(Cell).Column
    
    'DelColumnが1以上でセットされている時該当列をクリアする
    If 0 < DelColumn Then
        Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(65536, BaseCol + DelColumn)).Clear
    End If
    
    Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(BaseRow + y, BaseCol + x)) = TransposeData()
    
End Sub

好きな名前でもつけてくださいな。 使い方ですがサンプル内にコメントで追加しました。 ■値の追加、値の取り出し

Option Explicit

Sub SampleCode1()
    Dim Data As New Hogehoge
    Dim i As Long
    
    
    'Addメソッドに対し、Array関数で配列を作って渡せばよいです
    Call Data.Add(Array("A01", "B05", "C001", "D1", "なんとなくだめ"))
    Call Data.Add(Array("A01", "B10", "C002", "D2", "それとなくだめ"))
    Call Data.Add(Array("A01", "B15", "C003", "D3", "そこはかとなくだめ"))
    Call Data.Add(Array("A01", "B20", "C004", "D4", String(256, "■")))


    '一つ一つのデータにアクセスしたい場合はItemメソッドで
    '通常の二次元配列のようにアクセスするとよいです。
    For i = 0 To Data.Last
        Debug.Print Data.Item(0, i) & Data.Item(1, i) & Data.Item(2, i)
    Next
    
    
    '出力する際、いちいち領域を指定する必要はありません。
    '出力したいシートのオブジェクトと左上のセルを指定するだけで十分です。
    Call Data.Output(ThisWorkbook.ActiveSheet, "B3")
    
    '連続してコードを実行して出力する場合、前回出力したデータが残ってしまうので
    '出力時に該当する行より後ろの行をClearしたい時は、事前に列数を指定すると削除してくれます。
    Data.DeleteColumn = 5
    Call Data.Output(ThisWorkbook.ActiveSheet, "B3")
    
    'Clearメソッドで初期化されます。
    Call Data.Clear
    
    '一元配列ならいちいちArray関数にいれる必要はありません。
    Call Data.Add("abc")
    Call Data.Add("def")
    Call Data.Add("ghi")
    
    Call Data.Output(ThisWorkbook.ActiveSheet, "A10")
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar