Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

40989 / 76735

←次へ　｜　前へ→


	【40834】Re:集計表について'

ichinose - 06/7/24(月) 23:12 -


	引用なし

	パスワード

こんばんは。

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

試してみて下さい。

0 hits

▼

【40478】集計表について サン 06/7/14(金) 15:14