ピボットテーブルのマクロについて

会社で各営業支店のデータを集計する際、ピボットテーブルを使っています。毎回同じ作業なのでマクロの記録をしてみたのですが上手くできずに困っています。
各列に支店名、日付、商品名、数量のデータがあります。それを表に左に商品名、上に日付、右下に数量、一番上の欄に支店名が来るようにするにはどのように書けばよい教えて頂けませんでしょうか。
よろしくお願いします。

No.1 ベストアンサー 回答者： KenKen_SP 回答日時： 2005/11/06 03:49

こんにちは。

KenKen_SP です。

こんな感じでいけるかと、、、

Sub ピボットサンプル()

　　Dim pvtTBL　　As PivotTable
　　Dim rngDATA　 As Range
　　Dim rngTARGET As Range
　　Dim DUMMY　　 As String

　　'※ここでは Sheet1 のA1セル上で[Ctrl]+[*]キー押下で選択される
　　'　範囲をデータ範囲としています。
　　Set rngDATA = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion

　　'※ピボットテーブルの貼り付け先
　　Set rngTARGET = Sheets("Sheet2").Range("A1")


　　On Error Resume Next
　　DUMMY = rngTARGET.Parent.PivotTables("_Result").Name
　　If Err.Number > 0 Then
　　　　On Error GoTo 0
　　　　'ピボットが無ければ作成
　　　　Set pvtTBL = ThisWorkbook.PivotCaches.Add(xlDatabase, rngDATA) _
　　　　　　.CreatePivotTable( _
　　　　　　TableDestination:=rngTARGET, _
　　　　　　TableName:="_Result")
　　　　With pvtTBL
　　　　　　.AddFields RowFields:="商品名", ColumnFields:="日付"
　　　　　　With .PivotFields("数量")
　　　　　　　　.Orientation = xlDataField
　　　　　　　　.NumberFormat = "#,##0_ ;-#,##0;;@"
　　　　　　End With
　　　　　　With .PivotFields("支店名")
　　　　　　　　.Orientation = xlPageField
　　　　　　　　.Position = 1
　　　　　　End With
　　　　End With
　　Else
　　　　'ピボットが既にあればデータ範囲を修正して更新
　　　　On Error GoTo 0
　　　　Set pvtTBL = rngTARGET.Parent.PivotTables("_Result")
　　　　With pvtTBL
　　　　　　.SourceData = rngDATA.Parent.Name & "!" & rngDATA.Address(ReferenceStyle:=xlR1C1)
　　　　　　.PivotCache.Refresh
　　　　End With
　　End If
　　rngTARGET.Parent.Activate

　　Set pvtTBL = Nothing
　　Set rngDATA = Nothing
　　Set rngTARGET = Nothing

End Sub

この回答へのお礼

大変ありがとうございました。
おかげで作業が大幅に楽になりました。

お礼日時：2005/11/07 01:34