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

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

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

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

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

view plainprint?

1. Option Explicit  
2.   
3. Dim Data()    As String  
4. Dim x         As Long  
5. Dim y         As Long  
6. Dim DelColumn As Integer  
7.   
8. 'Setter/Getter  
9. Public Property Let DeleteColumn(ByVal num As Integer)  
10.     DelColumn = num  
11. End Property  
12.   
13. Public Property Get DeleteColumn() As Integer  
14.     DeleteColumn = DelColumn  
15. End Property  
16.   
17. Private Sub Class_Initialize()  
18.   
19.     '初期化  
20.     x = -1  
21.     y = -1  
22.   
23. End Sub  
24.   
25. Function Count()  
26.   
27.     '要素数を返す  
28.     Count = UBound(Data, 2) + 1  
29.   
30. End Function  
31.   
32. Function Item(ByVal a As Long, ByVal b As Long)  
33.       
34.     '要素の値を返す  
35.     Item = Data(a, b)  
36.       
37. End Function  
38.   
39. Function Last()  
40.   
41.     '最終要素を返す  
42.     Last = UBound(Data, 2)  
43.   
44. End Function  
45.   
46. Private Function TransposeData()  
47.     Dim s        As Long  
48.     Dim t        As Long  
49.     Dim TPData() As String  
50.     ReDim TPData(y, x)  
51.       
52.     For s = 0 To y  
53.         For t = 0 To x  
54.             TPData(s, t) = Data(t, s)  
55.         Next  
56.     Next  
57.       
58.     TransposeData = TPData  
59. End Function  
60.   
61. Function Value() As String()  
62.   
63.     '２次元配列自体を返す  
64.     Value = Data()  
65.   
66. End Function  
67.   
68. Sub Add(ByRef list As Variant)  
69.     Dim i As Long  
70.       
71.     '１次元の要素数が確定していない時、要素数の調査をおこなう  
72.     If x = -1 Then  
73.           
74.         If TypeName(list) = "Variant()" Then  
75.               
76.             x = UBound(list)  
77.           
78.         Else  
79.               
80.             x = 0  
81.           
82.         End If  
83.       
84.     End If  
85.       
86.       
87.     '要素数の再定義  
88.     y = y + 1  
89.     ReDim Preserve Data(x, y)  
90.       
91.     If TypeName(list) = "Variant()" Then  
92.           
93.         For i = 0 To x  
94.           
95.             '要素数が足りないときは、空文字を指定  
96.             On Error Resume Next  
97.             Data(i, y) = list(i)  
98.             On Error GoTo 0  
99.           
100.         Next  
101.           
102.     Else  
103.       
104.         Data(x, y) = list  
105.       
106.     End If  
107.   
108. End Sub  
109.   
110. Sub Clear()  
111.     Erase Data  
112.     DelColumn = -1  
113.     x = -1  
114.     y = -1  
115. End Sub  
116.   
117. Sub Output(ByVal Sht As Worksheet, ByVal Cell As String)  
118.     Dim BaseRow As Long  
119.     Dim BaseCol As Long  
120.       
121.     BaseRow = Sht.Range(Cell).Row  
122.     BaseCol = Sht.Range(Cell).Column  
123.       
124.     'DelColumnが1以上でセットされている時該当列をクリアする  
125.     If 0 < DelColumn Then  
126.         Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(65536, BaseCol + DelColumn)).Clear  
127.     End If  
128.       
129.     Sht.Range(Sht.Cells(BaseRow, BaseCol), Sht.Cells(BaseRow + y, BaseCol + x)) = TransposeData()  
130.       
131. End Sub  

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

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

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode1()  
4.     Dim Data As New Hogehoge  
5.     Dim i As Long  
6.       
7.       
8.     'Addメソッドに対し、Array関数で配列を作って渡せばよいです  
9.     Call Data.Add(Array("A01", "B05", "C001", "D1", "なんとなくだめ"))  
10.     Call Data.Add(Array("A01", "B10", "C002", "D2", "それとなくだめ"))  
11.     Call Data.Add(Array("A01", "B15", "C003", "D3", "そこはかとなくだめ"))  
12.     Call Data.Add(Array("A01", "B20", "C004", "D4", String(256, "■")))  
13.   
14.   
15.     '一つ一つのデータにアクセスしたい場合はItemメソッドで  
16.     '通常の二次元配列のようにアクセスするとよいです。  
17.     For i = 0 To Data.Last  
18.         Debug.Print Data.Item(0, i) & Data.Item(1, i) & Data.Item(2, i)  
19.     Next  
20.       
21.       
22.     '出力する際、いちいち領域を指定する必要はありません。  
23.     '出力したいシートのオブジェクトと左上のセルを指定するだけで十分です。  
24.     Call Data.Output(ThisWorkbook.ActiveSheet, "B3")  
25.       
26.     '連続してコードを実行して出力する場合、前回出力したデータが残ってしまうので  
27.     '出力時に該当する行より後ろの行をClearしたい時は、事前に列数を指定すると削除してくれます。  
28.     Data.DeleteColumn = 5  
29.     Call Data.Output(ThisWorkbook.ActiveSheet, "B3")  
30.       
31.     'Clearメソッドで初期化されます。  
32.     Call Data.Clear  
33.       
34.     '一元配列ならいちいちArray関数にいれる必要はありません。  
35.     Call Data.Add("abc")  
36.     Call Data.Add("def")  
37.     Call Data.Add("ghi")  
38.       
39.     Call Data.Output(ThisWorkbook.ActiveSheet, "A10")  
40. 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