集計関係サンプルマクロ

項目ごとに集計する 項目が複数ある場合のクロス集計

項目が1つ、値が1つだけの単純なものならDictionaryオブジェクトで十分ですが、
大分類の中に中分類があって、さらに小分類があって・・・・・・といったように
項目が複数の場合、クロス集計するにはADODBを使うと便利です。

ADODBとは?


ADODBとは、データベースにアクセスする方法で、これを使うと
ExcelでもAccessみたいにデータベースとして集計できます。

多少データベースの知識が必要ですが、Dictionaryオブジェクトだと
難しい高度な集計をしたいときに重宝します。

ピボットテーブルのデータ元にレコードセットを指定できるため、
特にExcelでクロス集計したいときに便利です。

レコードセットを元にピボットテーブルを作成する


まず、ADODBを使うには「Microsoft ActiveX Data Objects 2.x Library」参照設定が必要です。
xはバージョンが入ります。理由がなければ最新のバージョンにしておきます。

レコードセットを元にピボットテーブルを使う場合は、以下の流れになります。

  1. レコードセットにデータを取得

  2. PivotCachesコレクションに、PivotCacheオブジェクトを作成

  3. PivotCacheオブジェクトのRecordsetプロパティにレコードセットを指定

  4. CreatePivotTableメソッドでピボットテーブルを作成

  5. ピボットテーブルの行フィールド・列フィールド・合計フィールドを指定



サンプルコード



Sub レコードセットからピボットテーブルを作成する()

Dim objRS As New ADODB.Recordset
Dim objPivotCache As PivotCache
Dim strPivotName As String
Dim i As Long

With objRS
  '◆フィールド定義
  .Fields.Append "ID", adInteger
  .Fields.Append "カテゴリ", adVarChar, 1
  .Fields.Append "項目", adVarChar, 255
  .Fields.Append "日付", adDate
  .Fields.Append "値", adDouble
  .Open
  
  '◆レコード追加
  For i = 1 To 5
    .AddNew
    .Fields(0).Value = i
    .Fields(1).Value = Choose(i, "A", "B", "C", "D", "E")
    .Fields(2).Value = "Test" & i
    .Fields(3).Value = DateSerial(Year(Date), Month(Date), i)
    .Fields(4).Value = i * 1.5
  Next i
  
  .MoveFirst
End With

'◆ピボットテーブルの設定&作成
strPivotName = "集計結果"
Set objPivotCache = ThisWorkbook.PivotCaches.Add(xlExternal)
Set objPivotCache.Recordset = objRS
objPivotCache.CreatePivotTable ThisWorkbook.Worksheets(1).Range("A1"), strPivotName

'◆ピボットテーブルのフィールドの設定
With ThisWorkbook.Worksheets(1).PivotTables(strPivotName)
  '◆行フィールドの設定
  For i = 1 To 3
    .PivotFields(i).Orientation = xlRowField
    .PivotFields(i).Position = i
    .PivotFields(i).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
  Next i
  
  '◆列フィールド・合計フィールドの設定
  .PivotFields("日付").Orientation = xlColumnField
  .PivotFields("日付").Position = 1
  
  .PivotFields("値").Orientation = xlDataField
  
End With

'◆オブジェクト変数の解放
objRS.Close
Set objRS = Nothing
Set objPivotCache = Nothing


End Sub


ポイントは、Recordsetプロパティを設定するときにSetステートメントを使うことでしょうか。
Setステートメントを使わないとエラーが出ます。
ピボットテーブルの設定はマクロ記録でコードを取得して改変すると多少楽です。

あと、行フィールドはそのままだと小計行が出てきてしまうので、
SubtotalsプロパティはFalseにしておくとスッキリします。

集計関係サンプルマクロ

項目ごとに集計する Dictionaryオブジェクトでクロス集計

データの集計には配列をよく使います。
配列は便利なのですが、欠点があります。
それは、配列にどんな値があるかがわからないところです。

どんな値が入っているかわからないと、項目ごとに値を集計したい!というときに
困ってしまいます。
そういう時は、Dictionaryオブジェクトを使うと簡単に集計できます。

Dictionaryオブジェクトとは?


VBAで連想配列を使うときに使います。
連想配列とは、インデックス(添字)のかわりに任意の名前(キー)を設定できる配列のことです。
連想配列

Dictionaryオブジェクトの操作


Dictionaryオブジェクトの操作は基本的に以下の3つです。

1.Dictionaryオブジェクトに値を格納する
  Dictionaryオブジェクトに対してAddメソッドを実行します。
  Dictionaryオブジェクト.Add キー名,値
  指定したキー名がない場合は、新たに追加します。

2.Dictionaryオブジェクトから値を取り出す
  Dictionaryオブジェクト(キー名)のValueプロパティを参照します。
  Dictionaryオブジェクト(キー名).Value

3.指定したキー名があるか調べる
  Dictionaryオブジェクトに対してExistsメソッドを実行します。
  指定したキー名がある場合はTrue、ない場合はFalseが返ります。
  Dictionaryオブジェクト.Exists(strKey)

Dictionaryオブジェクトでクロス集計


上のような単純な項目ごとの集計だったらDictionaryオブジェクトを使うより、
SUMIF関数で計算した方が速いですね。
そこで、サンプルではDictionaryオブジェクトを使ってクロス集計をしてみます。

Dictionaryオブジェクトを使うには、「Microsoft Scripting Runtime」への参照設定が必要です。
キー項目は1つしか値を入れられないため、「項目名,日付」をキー項目にして
書き出すときにSplit関数でカンマでデータを区切って、配列に格納しています。

サンプルコード



Sub Dictionaryオブジェクトでクロス集計()

Dim objDIC As New Dictionary
Dim strKey As String
Dim tmp As Variant
Dim N As Variant
Dim i As Long
Dim ii As Long

For i = 1 To 5
  For ii = 1 To 3
    strKey = "Test" & i & "," & Format$(DateSerial(Year(Date), Month(Date), ii), "yyyy/mm/dd")
    If objDIC.Exists(strKey) = False Then
      objDIC.Add strKey, i
    End If
  Next ii
Next i

With ThisWorkbook.Worksheets(1)
  For Each N In objDIC
    i = 2
    ii = 2
    tmp = Split(N, ",")
    '◆行番号取得
    Do Until .Cells(i, ii).Value = ""
      If .Cells(i, "A").Value = tmp(0) Then
        Exit Do
      End If
      i = i + 1
    Loop
    
    '◆列番号取得
    Do Until .Cells(i, ii).Value = ""
      If .Cells(1, ii).Value = CDate(tmp(1)) Then
        Exit Do
      End If
      ii = ii + 1
    Loop
    
    '◆記入
    .Cells(i, "A").Value = tmp(0)
    .Cells(1, ii).Value = tmp(1)
    .Cells(i, ii) = objDIC(N)
    
  Next N

End With

End Sub


Powered by Seesaa
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。