| 
    
     |  | こんばんは。 
 >ということは、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にサンプルデータも作成します。
 
 
 試してみて下さい。
 
 |  |