VBAを活用して自動クロス集計【Excelマクロとピボットテーブルの応用術】

スポンサーリンク

VBAを活用して自動クロス集計

この記事では、タイトルの通りピボットテーブル、VBAを活用して自動でクロス集計をする方法を紹介します。

 

基本的にコードを紹介するので、好きにコピペして活用ください!

 

VBAの環境構築方法については以下を参考にしてください。

 

早速ですが、以下のような表があるとします。

表

この表を自動でクロス集計をし、以下のような結果にする。

クロス集計後の表

 

手順としては、以下のような感じです。

①ピボットテーブル作成

②クロス集計

③シートへ貼り付け

④デザインの調整

 

①ピボットテーブル作成

まず初めに、ピボットテーブルを作成します。コードは以下の通りです。

 

    ' ピボットテーブル用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ピボットテーブル"

    ' ピボットキャッシュ作成 → ピボットテーブル作成
    ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("Sheet1") _
    .Range("A1:I19")).CreatePivotTable Sheets("ピボットテーブル").Range("A3"), "ピボットテーブル1"
    
   ' ピボット選択 Sheets("ピボットテーブル").Select Cells(3, 1).Select  

この時点では、以下のような画像となります。

ピボットテーブル作成時点

 

 

また、ここで活用したコードの種類としては、

  • シートの追加
  • ピボットキャッシュ、ピボットテーブルの作成
  • セルの選択

 

シートの追加

    ' ピボットテーブル用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ピボットテーブル"

 

シートの追加に関しては、以下の記事をご覧ください。

 

ピボットキャッシュ、ピボットテーブルの作成

    ' ピボットキャッシュ作成 → ピボットテーブル作成
    ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("Sheet1") _
    .Range("A1:I19")).CreatePivotTable Sheets("ピボットテーブル").Range("A3"), "ピボットテーブル1"

 

ピボットキャッシュ、ピボットテーブルの作成に関しては、以下の記事をご覧ください。

 

セルの選択

    Sheets("ピボットテーブル").Select
    Cells(3, 1).Select

 

セルの選択に関しては、以下の記事をご覧ください。

 

②クロス集計

    ' フィールド設定
    With ActiveSheet.PivotTables("ピボットテーブル1")
        .PivotFields("学年").Orientation = xlRowField
        .PivotFields("国語").Orientation = xlDataField
        .PivotFields("数学").Orientation = xlDataField
        .PivotFields("英語").Orientation = xlDataField
        .PivotFields("社会").Orientation = xlDataField
        .PivotFields("理科").Orientation = xlDataField
    End With
    
    
    ' 平均値設定
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 国語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 数学")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 英語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 社会")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 理科")
        .Function = xlAverage
    End With

 

この時点では、以下のような画像となります。

ピボットテーブルの値を平均値に変更した表

 

また、ここで活用したコードの種類としては、

  • ピボットのフィールド設定
  • 値を平均値に変更

 

ピボットのフィールド設定

    ' フィールド設定
    With ActiveSheet.PivotTables("ピボットテーブル1")
        .PivotFields("学年").Orientation = xlRowField
        .PivotFields("国語").Orientation = xlDataField
        .PivotFields("数学").Orientation = xlDataField
        .PivotFields("英語").Orientation = xlDataField
        .PivotFields("社会").Orientation = xlDataField
        .PivotFields("理科").Orientation = xlDataField
    End With

 

ピボットフィールドの設定に関しては、以下の記事をご覧ください。

 

値を平均値に変更

    ' 平均値設定
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 国語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 数学")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 英語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 社会")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 理科")
        .Function = xlAverage
    End With

値の設定は以下の記事をそれぞれご覧ください。

 

③シートへ貼り付け

    ' 表作成用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "集計結果"
    
    ' ワークシートを変数に入れる
    Dim cross, pivot As Worksheet
    Set pivot = Worksheets("ピボットテーブル")
    Set cross = Worksheets("集計結果")
    
    ' 表のタイトルを入力
    With cross.Range("A2")
        .Value = "学年別平均値"
        .Font.Size = 14
        .Font.Bold = True
    End With
    
    ' ピボットテーブルをコピーして値貼り 
    pivot.Range("A4:F7").Copy
    cross.Range("A3").PasteSpecial Paste:=xlPasteValues

この時点では、以下のような画像となります。

値貼り後の表

 

また、ここで活用したコードの種類としては、

  • シートの追加
  • シートを変数に入れる
  • セルに文字を入力
  • 値貼り

 

シートを変数に入れる

    ' 表作成用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "集計結果"

シートを変数に入れる

    ' ワークシートを変数に入れる
    Dim cross, pivot As Worksheet
    Set pivot = Worksheets("ピボットテーブル")
    Set cross = Worksheets("集計結果")

セルに文字を入力

    ' 表のタイトルを入力
    With cross.Range("A2")
        .Value = "学年別平均値"
        .Font.Size = 14
        .Font.Bold = True
    End With

 

セルへの文字の入力に関しては、以下の記事をご覧ください。

 

値貼り付け

    pivot.Range("A4:F7").Copy
    cross.Range("A3").PasteSpecial Paste:=xlPasteValues

 

値貼り付けに関しては、以下の記事をご覧ください。

④デザインの調整

    ' 項目名変更+列幅調整
    With cross.Range("A3")
        .Value = "学年/科目"
        .Columns.AutoFit
    End With
    
    ' 列幅調整
    cross.Range("B3:F3").Columns.AutoFit
    
    '学年の表示形式
    cross.Range("A4:A6").NumberFormatLocal = "0年"
    
    '点数の小数点第1位表示+点数の表示形式
    cross.Range("B4:F6").NumberFormatLocal = "0.0点"
    
    '罫線
    cross.Range("A3:F6").Borders.LineStyle = xlContinuous
    
    'セルの色を変更
    cross.Range("A3:F3").Interior.Color = RGB(169, 208, 142)
    cross.Range("A4:A6").Interior.Color = RGB(198, 224, 180)

 

この時点では、以下のような画像となります。

デザインを整えた後の表

 

また、ここで活用したコードの種類としては、

  • 項目名変更+列幅調整
  • 表示形式の変更
  • 枠線
  • セルの背景の塗りつぶし

 

項目名変更+列幅調整

    ' 項目名変更+列幅調整
    With cross.Range("A3")
        .Value = "学年/科目"
        .Columns.AutoFit
    End With
    
    ' 列幅調整
    cross.Range("B3:F3").Columns.AutoFit

 

列幅の調整については、以下の記事をご覧ください。

 

表示形式の変更

    '学年の表示形式
    cross.Range("A4:A6").NumberFormatLocal = "0年"
    
    '点数の小数点第1位表示+点数の表示形式
    cross.Range("B4:F6").NumberFormatLocal = "0.0点"

 

セルの表示形式の変更については、以下の記事をご覧ください。

 

罫線

    '罫線
    cross.Range("A3:F6").Borders.LineStyle = xlContinuous

 

罫線の引き方については、以下の記事をご覧ください。

セルの背景の塗りつぶし 

    'セルの色を変更
    cross.Range("A3:F3").Interior.Color = RGB(169, 208, 142)
    cross.Range("A4:A6").Interior.Color = RGB(198, 224, 180)
 

総括

この時点で、学年別平均点を出しました。学年別最大値と最小値を出すためには、ピボットテーブルの値を変更し、貼り付けるセルを変えれば良いだけです。

 

全てのコードは以下のようになります。

Sub ピボット作成()

    ' ピボットテーブル用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "ピボットテーブル"

    ' ピボットキャッシュ作成 → ピボットテーブル作成
    ThisWorkbook.PivotCaches.Create(xlDatabase, Worksheets("Sheet1") _
    .Range("A1:I19")).CreatePivotTable Sheets("ピボットテーブル").Range("A3"), "ピボットテーブル1"
    
    Sheets("ピボットテーブル").Select
    Cells(3, 1).Select
    
    ' フィールド設定
    With ActiveSheet.PivotTables("ピボットテーブル1")
        .PivotFields("学年").Orientation = xlRowField
        .PivotFields("国語").Orientation = xlDataField
        .PivotFields("数学").Orientation = xlDataField
        .PivotFields("英語").Orientation = xlDataField
        .PivotFields("社会").Orientation = xlDataField
        .PivotFields("理科").Orientation = xlDataField
    End With
    
    
    ' 平均値設定
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 国語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 数学")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 英語")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 社会")
        .Function = xlAverage
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / 理科")
        .Function = xlAverage
    End With
    
    ' 表作成用のシート追加
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "集計結果"
    
    ' ワークシートを変数に入れる
    Dim cross, pivot As Worksheet
    Set pivot = Worksheets("ピボットテーブル")
    Set cross = Worksheets("集計結果")
    
    ' 表のタイトルを入力
    With cross.Range("A2")
        .Value = "学年別平均値"
        .Font.Size = 14
        .Font.Bold = True
    End With
    
    ' ピボットテーブルをコピーして値貼り
    pivot.Range("A4:F7").Copy
    cross.Range("A3").PasteSpecial Paste:=xlPasteValues
    
    ' 項目名変更+列幅調整
    With cross.Range("A3")
        .Value = "学年/科目"
        .Columns.AutoFit
    End With
    
    ' 列幅調整
    cross.Range("B3:F3").Columns.AutoFit
    
    '学年の表示形式
    cross.Range("A4:A6").NumberFormatLocal = "0年"
    
    '点数の小数点第1位表示+点数の表示形式
    cross.Range("B4:F6").NumberFormatLocal = "0.0点"
    
    '罫線
    cross.Range("A3:F6").Borders.LineStyle = xlContinuous
    
    'セルの色を変更
    cross.Range("A3:F3").Interior.Color = RGB(169, 208, 142)
    cross.Range("A4:A6").Interior.Color = RGB(198, 224, 180)
    
    Application.Goto Sheets("ピボットテーブル").Range("A3")
    
    '最大値設定
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("平均 / 国語")
        .Function = xlMax
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("平均 / 数学")
        .Function = xlMax
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("平均 / 英語")
        .Function = xlMax
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("平均 / 社会")
        .Function = xlMax
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("平均 / 理科")
        .Function = xlMax
    End With

    ' 表のタイトルを入力
    With cross.Range("A8")
        .Value = "学年別最高得点"
        .Font.Size = 14
        .Font.Bold = True
    End With
    
    ' ピボットテーブルをコピーして値貼り
    pivot.Range("A4:F7").Copy
    cross.Range("A9").PasteSpecial Paste:=xlPasteValues
    
    ' 項目名変更+列幅調整
    With cross.Range("A9")
        .Value = "学年/科目"
        .Columns.AutoFit
    End With
    
    cross.Range("B9:F9").Columns.AutoFit
    
    '学年の表示形式
    cross.Range("A10:A12").NumberFormatLocal = "0年"
    
    '点数の表示形式
    cross.Range("B10:F12").NumberFormatLocal = "0点"
    
    '罫線
    cross.Range("A9:F12").Borders.LineStyle = xlContinuous
    
    'セルの色を
    cross.Range("A9:F9").Interior.Color = RGB(169, 208, 142)
    cross.Range("A10:A12").Interior.Color = RGB(198, 224, 180)

    '最小値設定
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("最大 / 国語")
        .Function = xlMin
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("最大 / 数学")
        .Function = xlMin
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("最大 / 英語")
        .Function = xlMin
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("最大 / 社会")
        .Function = xlMin
    End With
    
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("最大 / 理科")
        .Function = xlMin
    End With

    With cross.Range("A14")
        .Value = "学年別最低得点"
        .Font.Size = 14
        .Font.Bold = True
    End With
    
    pivot.Range("A4:F7").Copy
    cross.Range("A15").PasteSpecial Paste:=xlPasteValues
    
    With cross.Range("A15")
        .Value = "学年/科目"
        .Columns.AutoFit
    End With
    
    cross.Range("B15:F15").Columns.AutoFit
    
    '学年の表示形式
    cross.Range("A16:A18").NumberFormatLocal = "0年"
    
    '点数の表示形式
    cross.Range("B16:F18").NumberFormatLocal = "0点"
    
    '罫線
    cross.Range("A15:F18").Borders.LineStyle = xlContinuous
    
    'セルの色を
    cross.Range("A15:F15").Interior.Color = RGB(169, 208, 142)
    cross.Range("A16:A18").Interior.Color = RGB(198, 224, 180)

End Sub

 

3種類の表で全てデザインが同じの場合、先にピボットテーブルのコピペを済ませて、デザインを最後に一括で整えるようにすれば、コードを短くすることができるので、ぜひチャレンジしてみてください。

 

以下の書籍はマクロを勉強するためにおすすめの書籍となります。これからさらに勉強される方は、ぜひ一読下さい。