Top> よくつかうプログラム> ピポットテーブルの作成

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

ピポットテーブルの作成

ピポットテーブルの作成
ピポットテーブルはデータ分析ツールとしてエクセルでよく使われる作業です。
改良されて使いやすくなっていますが、データが追加になった場合は選択範囲を変更しなければなりません。
条件を入力して定型業務として使う場合はVBAで作らないと面倒です。

Ⅰ)1次元の場合

ピポットテーブルの作成

ピポットテーブルの場合

ピポットテーブルの作成

ピポットテーブルの作成

VBAで作る場合
(1)dataを作業シートにコピーする。
(2)作業シートをコードで並び替える
(3)コードで集計したデータを作業1シートにコピーする

ピポットテーブルの作成

Sub 項目1つ()
  Dim i As Long
  Dim j As Long
  Dim lastrow As Long
  Dim kei As Long
'dataを作業シートへコピー
  Worksheets("作業").Cells.Clear
  Worksheets("作業").Select
  lastrow = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To lastrow
    For j = 1 To 2
      Worksheets("作業").Cells(i, j) = Worksheets("data").Cells(i, j)
    Next
  Next
'作業シートを1列目コードで並び替える
  Worksheets("作業").Activate
  Range(Cells(2, 1), Cells(lastrow, 2)).Select
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
  :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("作業").Sort
  .SetRange Range(Cells(2, 1), Cells(lastrow, 2))
  .Header = xlNo
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
'ピポット作成コード計を作業1に取り出す
  Worksheets("作業1").Cells.Clear
  Worksheets("作業1").Cells(1, 1) = "コード"
  Worksheets("作業1").Cells(1, 2) = "金額"
  j = 2
  kei = 0
  For i = 2 To lastrow
    kei = kei + Worksheets("作業").Cells(i, 2)
    If Worksheets("作業").Cells(i, 1) <> Worksheets("作業").Cells(i + 1, 1) Then
      Worksheets("作業1").Cells(j, 1) = Worksheets("作業").Cells(i, 1)
      Worksheets("作業1").Cells(j, 2) = kei
      j = j + 1
      kei = 0
    End If
  Next
  Worksheets("作業1").Select

Ⅱ)2次元の場合

ピポットテーブルの作成

ピポットテーブルの場合

ピポットテーブルの作成

ピポットテーブルの作成

VBAで作る場合
(1)元データ(data1)をコードと区分で並び替える
(2)コードと区分で集計をとる

ピポットテーブルの作成

ピポットテーブルの作成

(3)2次元の集計表を作成する

ピポットテーブルの作成

ピポットテーブルの作成

(4)作業1(コード・区分で集計したシート)を作業に転記(金額の入った2次元の集計表が作業に完成

(5)合計・列計・行計をつける

ピポットテーブルの作成

Sub 項目2つ()
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim kei As Long
  Dim retu As Long
  Dim lastrow As Long
  Dim lastrow1 As Long
'data1作業シートへコピー
  Worksheets("作業").Cells.Clear
  lastrow = Worksheets("data1").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To lastrow
    For j = 1 To 3
      Worksheets("作業").Cells(i, j) = Worksheets("data1").Cells(i, j)
    Next
  Next
  Worksheets("作業").Select
'作業シートを1列目コードと2列目コードで並び替える
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  Worksheets("作業").Activate
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  Range(Cells(2, 1), Cells(lastrow, 3)).Select
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
  :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 2), SortOn _
  :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("作業").Sort
  .SetRange Range(Cells(2, 1), Cells(lastrow, 3))
  .Header = xlNo
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
'コードと区分で集計して作業1に取り出す(データ集計作業1完了)
  Worksheets("作業1").Cells(1, 1) = "コード"
  Worksheets("作業1").Cells(1, 2) = "区分"
  Worksheets("作業1").Cells(1, 3) = "金額"
  k = 2
  kei = 0
  For i = 2 To lastrow
    kei = kei + Worksheets("作業").Cells(i, 3)
    If Worksheets("作業").Cells(i, 1) <> Worksheets("作業").Cells(i + 1, 1) Or Worksheets("作業").Cells(i, 2) <> Worksheets("作業").Cells(i + 1, 2) Then
      Worksheets("作業1").Cells(k, 1) = Worksheets("作業").Cells(i, 1)
      Worksheets("作業1").Cells(k, 2) = Worksheets("作業").Cells(i, 2)
      Worksheets("作業1").Cells(k, 3) = kei
      k = k + 1
      kei = 0
    End If
  Next
'2次元の集計表を作成する
'作業の区分を並び替える(列項目を作り出すための準備)
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  Worksheets("作業").Activate
  Range(Cells(2, 1), Cells(lastrow, 2)).Select
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 2), SortOn _
  :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("作業").Sort
  .SetRange Range(Cells(2, 1), Cells(lastrow, 2))
  .Header = xlNo
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
'作業から区分を取り出す重複をなくす作業2に作成(列項目を作り出す作業2の行にできている)
  lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  Worksheets("作業2").Cells.Clear
  Worksheets("作業2").Cells(1, 1) = "区分"
  k = 2
  For i = 2 To lastrow
    If Worksheets("作業").Cells(i, 2) <> Worksheets("作業").Cells(i + 1, 2) Then
      Worksheets("作業2").Cells(k, 1) = Worksheets("作業").Cells(i, 2)
      k = k + 1
    End If
  Next
  Worksheets("作業2").Select
'作業2の区分の項目を作業に列に転記(2次元の集計表列項目が作業に完成)
  Worksheets("作業").Cells.Clear
  lastrow = Worksheets("作業2").Cells(Rows.Count, 1).End(xlUp).Row
  k = 2
  For i = 2 To lastrow
    Worksheets("作業").Cells(1, k) = Worksheets("作業2").Cells(i, 1)
    k = k + 1
  Next
  retu = k - 1
'作業1からコードを取り出す重複をなくしながら作業に作成(2次元の集計表行項目が作業に完成)
  lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
  k = 2
  For i = 2 To lastrow
    If Worksheets("作業1").Cells(i, 1) <> Worksheets("作業1").Cells(i + 1, 1) Then
      Worksheets("作業").Cells(k, 1) = Worksheets("作業1").Cells(i, 1)
      k = k + 1
    End If
  Next
'作業1(コード・区分で集計したシート)を作業に転記(金額の入った2次元の集計表が作業に完成)
  lastrow = Worksheets("作業1").Cells(Rows.Count, 1).End(xlUp).Row
  lastrow1 = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    For j = 2 To lastrow1
      If Worksheets("作業1").Cells(i, 1) = Worksheets("作業").Cells(j, 1) Then
        For k = 2 To retu
          If Worksheets("作業1").Cells(i, 2) = Worksheets("作業").Cells(1, k) Then
            Worksheets("作業").Cells(j, k) = Worksheets("作業1").Cells(i, 3)
            Exit For
          End If
        Next
        Exit For
      End If
    Next
  Next
'合計の計算
  Worksheets("作業").Cells(lastrow1 + 1, 1) = "合計"
  Worksheets("作業").Cells(1, retu + 1) = "合計"
'列計
  For j = 2 To retu
    For i = 2 To lastrow1
      kei = kei + Worksheets("作業").Cells(i, j)
    Next
    Worksheets("作業").Cells(lastrow1 + 1, j) = kei
    kei = 0
  Next
'行計
  For i = 2 To lastrow1
    For j = 2 To retu
      kei = kei + Worksheets("作業").Cells(i, j)
    Next
    Worksheets("作業").Cells(i, retu + 1) = kei
    kei = 0
  Next
'総計
  For i = 2 To lastrow1
    kei = kei + Worksheets("作業").Cells(i, retu + 1)
  Next
  Worksheets("作業").Cells(lastrow1 + 1, retu + 1) = kei
  Worksheets("作業").Select
End Sub

先頭へ

 

 

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)