例文を使って繰り返し業務を時短

【マクロ・VBA】ピポットテーブルの作成・更新・加工

エクセル、マクロ、VBAでピポットテーブルの作成、更新、加工をする方法 VBA

ピボットテーブルの作成

*指定した範囲内のデータを使用して、新しいシートにピボットテーブルを作成しています。

ThisWorkbook.Worksheets("Sheet1").Range("A1:D10")でSheet1のA1:D10の範囲をピボットテーブルの範囲として設定しています。

ピボットテーブルのキャッシュを作成し、そのキャッシュを使用して、ピボットテーブルを作成しています。

ピボットテーブルにフィールドを追加するには、PivotFieldsプロパティを使用してフィールドを指定し、Orientationプロパティを使用して、フィールドの方向(行フィールド、列フィールド、値フィールドなど)を設定します。

最後に、ptTable変数に割り当てたピボットテーブルオブジェクトを使用して、ピボットテーブルの設定を行っています。

Sub CreatePivotTable()
    Dim ptSheet As Worksheet
    Set ptSheet = Worksheets.Add 'ピボットテーブルを作成するシートを作成
    
    Dim ptRange As Range
    Set ptRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:D10") 'ピボットテーブルの範囲を指定
    '※上記の例ではSheet1のA1:D10がピボットテーブルの範囲
    
    Dim ptCache As PivotCache
    Set ptCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ptRange) 'ピボットテーブルのキャッシュを作成
    
    Dim ptTable As PivotTable
    Set ptTable = ptSheet.PivotTables.Add(PivotCache:=ptCache, TableDestination:=ptSheet.Range("A3")) 'ピボットテーブルを作成
    
    With ptTable
        'ピボットテーブルにフィールドを追加
        .PivotFields("Category").Orientation = xlRowField '行フィールドに設定
        .PivotFields("Region").Orientation = xlRowField '行フィールドに設定
        .PivotFields("Sales").Orientation = xlDataField '値フィールドに設定
    End With
End Sub

別パターン

Sub ピボットテーブルの作成()
  Dim pvt As PivotTable
  Dim src As Range

  ' データを変数に格納
  Set src = ActiveSheet.Range("A1").CurrentRegion

  ' ピボットテーブルを作成するシートを作成
  Worksheets.Add(After:=ActiveSheet).Name = "ピポットテーブル" & "_" & VBA.Format(Now(), "h時mm分ss秒")
  'Sheets.Add

  ' ピボットテーブル作成
  Set pvt = _
    ActiveWorkbook.PivotCaches.Add( _
        SourceType:=xlDatabase, _
        SourceData:=src). _
            CreatePivotTable(TableDestination:=Range("A3"))

  ' フィールド
  With pvt
    .PivotFields("店舗").Orientation = xlRowField  '行フィールド
    .PivotFields("性別").Orientation = xlColumnField  '列フィールド
    .PivotFields("名前").Orientation = xlDataField  '値フィールド
    .PivotFields("年齢").Orientation = xlPageField 'フィルターフィールド
    
  End With

MsgBox "完了"
End Sub

指定列を並び替える方法

ピボットテーブルの指定された列を並び替えるには、PivotField.AutoSortメソッドを使用します。以下は、昇順または降順に指定されたフィールドの値でピボットテーブルをソートするための例です。

Sub SortPivotTableColumn()
    Dim pt As PivotTable
    Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
    
    Dim field As PivotField
    Set field = pt.PivotFields("Category")
    
    With field
        .AutoSort xlAscending, "Category" '昇順でソート
        '.AutoSort xlDescending, "Category" '降順でソート
    End With
End Sub

シート名が”Sheet1″であり、ピボットテーブル名が”PivotTable1″であると仮定しています。ピボットテーブル内で並び替えたい列に対応するPivotFieldオブジェクトを取得し、AutoSortメソッドを使用してソート方法を指定します。

最初の引数で昇順または降順のソート方法を指定し、2番目の引数でソート対象のフィールド名を指定します。

ダミーデータのダウンロード

ピポットテーブルの作成とグラフの作成

Sub ピボットテーブル作成()

With Application 
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With        

'①対象シートと範囲指定
Dim targetSheet As Worksheet
Set targetSheet = ThisWorkbook.Worksheets("横から縦") 
        
Dim MaxRow1 As Long 
MaxRow1 = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Set rH = targetSheet.Range("A33:A" & MaxRow1)
        
Dim MaxCol1 As Long 
MaxCol1 = targetSheet.Cells(1, Columns.Count).End(xlToLeft).Column 
'Set cH = targetSheet.Range("E33:E" & MaxCol1)
    
'②結果出力シート
'Dim outputSheet As Worksheet
'Set outputSheet = ThisWorkbook.Worksheets("横から縦") 

'③処理A(ピボットテーブル作成)
Dim キャッシュ As PivotCache
Dim テーブル As PivotTable
Set キャッシュ = ThisWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=targetSheet.Range("A2").CurrentRegion)

Worksheets.Add

Set テーブル = キャッシュ.CreatePivotTable _
(tabledestination:=Range("A2"), TableName:="集計表")


'フィールドの配置
With ActiveSheet.PivotTables("集計表").PivotFields("ランク")
    .Orientation = xlRowField
    .Position = 1
End With

ActiveSheet.PivotTables("集計表").AddDataField ActiveSheet.PivotTables( _
     "集計表").PivotFields("氏名"), "データの個数 / 氏名", xlCount

ActiveSheet.PivotTables("集計表").AddDataField ActiveSheet.PivotTables( _
     "集計表").PivotFields("売上"), "合計 / 売上", xlSum

'③処理B(グラフ作成)
Dim グラフ範囲 As Range
Set グラフ範囲 = Range("G1:P25")  

With ActiveSheet.ChartObjects.Add(グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height)
    .Chart.SetSourceData Source:=ActiveSheet.PivotTables("集計表").TableRange1
End With
           
With ActiveSheet.ChartObjects(1).Chart
    .ApplyDataLabels ShowValue:=True
    .HasTitle = True
    .ChartTitle.Text = "タイトル"
        With .ChartTitle.Format.TextFrame2.TextRange.Font
            .Size = 14
            '.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent2
        End With
End With

ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).AxisGroup = 2
    
ActiveSheet.ChartObjects("グラフ 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ChartType = xlLineMarkers
    
'ActiveSheet.ChartObjects("グラフ 1").Activate
'ActiveChart.Legend.Select
'ActiveSheet.PivotTables("集計表").PivotFields("氏名カウント").Caption = "氏名[カウント]"

Range("A1").Select

'Columns("A").Delete 'Columns("A:E").Delete
    
Application.CutCopyMode = False


Application.Calculation = xlAutomatic 
Application.ScreenUpdating = True  
Application.DisplayAlerts = True 

MsgBox "完了"

End Sub

ピポットテーブルの更新

Sub ピポット更新()

Worksheets("ピボットテーブル").PivotTables("ピボット1").PivotCache.Refresh

End Sub

ピポットテーブルの加工

Sub ピポット加工()

' ピボットシートの条件付き書式を削除する
Worksheets("ピボットテーブル").Cells.FormatConditions.Delete
     
' データエリアを選択
Worksheets("ピボットテーブル").PivotTables("ピボット1").PivotSelect "", xlDataOnly

' 条件の設定:0より小さい場合
Selection.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlLess, Formula1:="0"

' 文字を赤色に
Selection.FormatConditions(1).Font.ColorIndex = 3

MsgBox "完了"
End Sub

コメント

タイトルとURLをコピーしました