アドベントカレンダー 24日目
データを蓄積してそれを最後にセルに出力するなんてことはあると思うのですが
データ量が増えるとエクセルに出力する部分がえらく時間がかかるようになります
高速で出力するには、配列に格納して出力するのが最速となります。
ただ…
出力する時に行と列をいれかえる必要があったりCollectionならAddするだけで
要素が追加できるとこをいちいち、要素数が存在しない時と存在する時で処理を
分岐して毎回Redim Preserveしなきゃいけないなんてのはめんどくさい以外の
何者でもありません。
そういうのは、裏側でこっそり処理して表側には見えないようにしてあげた方が便利よいですよね。
そんなわけで、セルに出力することに特化させた二次元配列のクラスを作ってみました。
データを蓄積してそれを最後にセルに出力するなんてことはあると思うのですが
データ量が増えるとエクセルに出力する部分がえらく時間がかかるようになります
高速で出力するには、配列に格納して出力するのが最速となります。
ただ…
出力する時に行と列をいれかえる必要があったり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
