ピボットテーブルのマクロでシートを指定、連続

質問

• ピボットテーブルを作成するマクロを使用して、指定したシートで連続的に処理を行いたいです。しかし、いくつかの問題が発生しています。
• まず、マクロの自動記録機能を使用してピボットテーブルを作成しましたが、指定したシートに表が表示されず、データを取得できませんでした。
• さらに、別のExcelファイルに保存されているマクロを実行しようとしていますが、正しい記述方法がわかりません。

回答No.4

end-u · ベストアンサー

単純に４つつなげて、かつ新規シートにピボットを作成するだけなら以下。
Sub try02()
　　Dim pt　As PivotTable 'ピボットテーブル用変数を準備
　　Dim rng As Range　　　'データ範囲用変数を準備

　　Application.ScreenUpdating = False
　　'マクロがあるBookなら『 With ThisWorkbook 』 でも可
　　With ThisWorkbook 'Workbooks("Pivot01.xls")
　　　　'----------------------------------------------------------
　　　　'Gシートの E列最終行から K1セルまでの矩形範囲がデータ範囲？
　　　　With .Sheets("G")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　'ピボットテーブルを作成して変数に格納
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　'以下、変数ptを利用してピボットを操作
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:=Array("距離", "着順")
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("D")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:=Array("距離", "着順")
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("GSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:="着順"
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　　　'----------------------------------------------------------
　　　　With .Sheets("DSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Set pt = .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　　　　　　　　　 .CreatePivotTable _
　　　　　　　　　　　　　　　　 (TableDestination:=.Worksheets.Add.Range("A1"))
　　　　pt.NullString = "0"
　　　　pt.AddFields RowFields:="騎手名", _
　　　　　　　　　　 ColumnFields:="着順"
　　　　With pt.PivotFields("着順")
　　　　　　.Orientation = xlDataField
　　　　　　.Function = xlCount
　　　　End With
　　End With
End Sub

出来上がりの形がわからないので参考ですが
サブプロシージャを使ってまとめると以下のような感じです。
Sheet1にまとめて作成します。

Sub try03()
　　Dim pt　As PivotTable
　　Dim rng As Range

　　Application.ScreenUpdating = False
　　With ThisWorkbook 'Workbooks("Pivot01.xls")
　　　　.Sheets("Sheet1").UsedRange.Clear
　　　　With .Sheets("G")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("距離", "着順"), "着順")
　　　　With .Sheets("D")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("距離", "着順"), "着順")
　　　　With .Sheets("GSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("着順"), "着順")
　　　　With .Sheets("DSG")
　　　　　　Set rng = .Range("K1", .Cells(.Rows.Count, "E").End(xlUp))
　　　　End With
　　　　Call SubPivot(rng, Array("騎手名"), Array("着順"), "着順")
　　End With
End Sub

Sub SubPivot(rng As Range, r, c, f As String)
　　Dim dest As Range

　　With ThisWorkbook
　　　　With .Sheets("Sheet1")
　　　　　　Set dest = .Cells(.Rows.Count, 1).End(xlUp).Offset(2)
　　　　End With
　　　　With .PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng) _
　　　　　　　　.CreatePivotTable(TableDestination:=dest)
　　　　　　.NullString = "0"
　　　　　　.AddFields RowFields:=r, _
　　　　　　　　　　　 ColumnFields:=c
　　　　　　With .PivotFields(f)
　　　　　　　　.Orientation = xlDataField
　　　　　　　　.Function = xlCount
　　　　　　End With
　　　　End With
　　End With
End Sub

お礼

何度もありがとうございました。
マクロの理解は追いつきませんでしたが、作動は完璧です。
少しずつ勉強していきます。