Google
WWW を検索 tips.asablo.jp 内を検索
 このブログサイト(tips blog)の中だけを検索できます。
 アサブロへの設定方法は、こちらをクリック

VBAでGetPivotDataを使う2018/01/27 11:12


VBAでピボットテーブルを作り、さらにその集計データを利用しようとしたけれど、よいサンプルが見当たらなかったので作ってみました。

GetPivotData関数を使っているサイトはいくつかサンプルがありますが、GetPivotDataメソッドを使っているサイトは私が見た範囲では見当たりませんでした。

参考にしたサイトはこちらです。
http://www.databison.com/how-to-read-data-from-pivot-table-using-vba/

元データはこんな感じです。
Table

作成されるピボットテーブルはこんな感じです。
Pivot

そして、ピボットから作られるリストはこんな感じです。

List

で、コードです。

Qtyも追加してデータフィールドを二つにしたパターンも作ってみましたが、複雑になるのでやめました。

データフィールドが複数ある場合には、基本的には次のように回すことになりますが、列名に対する考慮が必要になりそうです。
for uDataField in uPvtTable.DataFields

後は、ループの中でif文等を使って、煮るなり焼くなりすればよいと思います。

Option Explicit

Sub uPivotDemo()
    Dim uPvtTableName As String
    
    uCreatePivot
    uCopyPvtValue
End Sub

Private Sub uCreatePivot()
    Dim uTable As ListObject
    Dim uTableSheet As Worksheet
    Dim uBasename As String
    
    Dim uPvtsheet As Worksheet
    Dim uPvtCache As PivotCache
    Dim uPvtTableName As String
    
    Set uTable = ActiveCell.ListObject
    If uTable Is Nothing Then
        If ActiveSheet.ListObjects.Count = 0 Then
            MsgBox "テーブルが必要です"
            Exit Sub
        Else
            Set uTable = ActiveSheet.ListObjects(1)
        End If
    End If
    
    Set uTableSheet = ActiveSheet
    uBasename = uTableSheet.Name

    'ピボットテーブル用シート追加
    Set uPvtsheet = Sheets.Add(after:=Worksheets(uTableSheet.Name))
    uPvtsheet.Name = uBasename & "Sum"
    
    
    'キャッシュ作成 (データソースとなるテーブルから)
    Set uPvtCache = ActiveWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=uTable.Name)
    
    uPvtTableName = uBasename & "PvtTable"
    
    
    'ピボットテーブル作成 (キャッシュから)
    uPvtCache.CreatePivotTable _
        TableDestination:=uPvtsheet.Range("A3"), _
        TableName:=uPvtTableName
    
    
    Sheets(uPvtsheet.Name).Select
    Cells(3, 1).Select
    
    
    '集計パラメーター設定
    With ActiveSheet.PivotTables(uPvtTableName).PivotFields("Country")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables(uPvtTableName).PivotFields("City")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables(uPvtTableName).AddDataField _
        ActiveSheet.PivotTables(uPvtTableName).PivotFields("Amount"), "合計 / Amount", xlSum
End Sub

Private Sub uCopyPvtValue()
    Dim uPvtTable As PivotTable
    Dim i As Long
    
    Dim uRowField As PivotField
    Dim uRowItem As PivotItem
    Dim uColField As PivotField
    Dim uColItem As PivotItem
    
    Dim uDataField As String
    
    Set uPvtTable = ActiveSheet.PivotTables(1)
    
    'i = Cells(Rows.Count, 1).End(xlUp).Row + 3
    i = 13
    
    For Each uRowField In uPvtTable.RowFields
        For Each uRowItem In uRowField.PivotItems
            For Each uColField In uPvtTable.ColumnFields
                For Each uColItem In uColField.PivotItems
                    uDataField = uPvtTable.DataFields(1).SourceName
                    
                    Cells(i, 1).Value = uRowItem.Name   'Bngkok, Frankfurt, ...
                    Cells(i, 2).Value = uColItem.Name   'Germany, Japan, Thailand
                    
                    Cells(i, 3).Value = uPvtTable.GetPivotData( _
                        uDataField, uRowField.Name, uRowItem.Name)  'City Total
                        
                    Cells(i, 4).Value = uPvtTable.GetPivotData( _
                        uDataField, uColField.Name, uColItem.Name)  'Country Total
                        
                    Cells(i, 5).Value = uPvtTable.GetPivotData( _
                        uDataField, _
                        uRowField.Name, uRowItem.Name, _
                        uColField.Name, uColItem.Name)  'Country City total
                        
                    i = i + 1
                Next
            Next
        Next
    Next
    
End Sub

Google
WWW を検索 tips.asablo.jp 内を検索
 このブログサイト(tips blog)の中だけを検索できます。
 アサブロへの設定方法は、こちらをクリック