|
こんばんは。
>ということは、Collection で、結構、集計をしていたってことですね。
まあ、クラスを通しての集計ですけどね!!
CollectionのItemに直接配列などを指定すると
書き換えが出来ないため、Removeして再度 Addしなければなりません。
これ、データが多いとちょっと時間がかかります。
Itemとしてクラスで定義したオブジェクトを登録します。
こうすると、オブジェクトのプロパティは変更ができます。
新規ブックの
クラスモジュール(Class1)に
'===================================================
Private a(6) As Variant
'=========================
Property Get myarray(i)
myarray = a(i)
End Property
'=================================
Property Let myarray(i, myvalue)
a(i) = myvalue
End Property
'=================================
Function get_array()
get_array = a()
End Function
標準モジュールに
'======================================================
Sub 集計3()
Dim vnt
Dim cls As Class1
Dim i As Long
Dim col As Collection
Dim chk_exsist As Variant '
Call mk_sample
DoEvents
MsgBox "サンプル作成"
With Sheets("Sheet1")
vnt = .Range("g2", .Range("A65536").End(xlUp)).Value
End With
On Error Resume Next '
Set col = New Collection
For i = 1 To UBound(vnt, 1)
Err.Clear
Set chk_exsist = col(CStr(vnt(i, 1)))
If Err.Number <> 0 Then
Set cls = New Class1
With cls
.myarray(0) = vnt(i, 1)
.myarray(1) = vnt(i, 2)
.myarray(2) = vnt(i, 3)
.myarray(3) = vnt(i, 4)
End With
col.Add cls, CStr(vnt(i, 1))
End If
With col(CStr(vnt(i, 1)))
.myarray(4) = .myarray(4) + vnt(i, 5)
.myarray(5) = .myarray(5) + vnt(i, 6)
.myarray(6) = .myarray(6) + vnt(i, 7)
End With
Next i
'-----結果出力
With Sheets("Sheet2")
.Cells.ClearContents
.Range("A1").Resize(, 7).Value = Array("コード", "業種", _
"顧客名", "フリガナ", "売上", "消費税", "合計")
For i = 1 To col.Count
With .Range("a2")
.Cells(i, 1).Resize(, 7).Value = col(i).get_array
End With
Next
.Select
End With
'
Erase vnt
Set col = Nothing
End Sub
'====================================================================
Sub mk_sample()
Dim g0 As Long
With Worksheets("sheet1")
.Cells.ClearContents
.Range("A1").Resize(, 7).Value = Array("コード", "業種", _
"顧客名", "フリガナ", "売上", "消費税", "合計")
For g0 = 1 To 10000
.Range("a1").Offset(g0, 0).Resize(, 7).Value = _
Array((g0 Mod 300) + 1, 4, "ああ", "アア", g0 * 100, Int(g0 * 100 * 0.05), g0 * 100 + Int(g0 * 100 * 0.05))
Next
End With
End Sub
これで、mainを実行してみて下さい。
ブックの各シート(Sheet1とSheet2は用意して下さい)は
何も入力しないで下さい。
コードでSheet1にサンプルデータも作成します。
試してみて下さい。
|
|