Oracle活用 Excelからデータを取得する②ピボットテーブル作っちゃう
今日は朝からちょっと用事があったので、新宿にお出掛けして、
午後はネイルを変えてきました~♪
ネイルが変わっただけで気分は上々です!!
今日は…
Oracle活用 Excelからデータを取得する①の続きで、
取得したデータをピボットテーブルにしちゃいます。
たぶん営業さんとか事務のお姉さんってExcelは普通に使えても、
ピボットテーブルまで使いこなせる人ってなかなかいないと思うんだよね。
でも部署別の売上とか、1年分のデータの月毎とか…色んな形でデータ集計って必要になるはず。
なので、データを表示するだけじゃなくて、集計までしてあげよう!!
前回はこんな感じでデータを表示させました。
今回は少しプログラムを追加して、
こんな感じにシートを追加して、ピボットテーブルを作成しちゃいます。
ソースはこちら。
追加部分は['ADD 2015/08/09 START]から['ADD 2015/08/09 END]までです。
' ************************************************************************************************ ' *** ' *** 社員マスタを抽出し、部署毎の人件費(給与)をピボットテーブルで集計する。 ' *** ' *** 概要:OO4Oを使用。Oracleのデータ取得処理。 ' *** ' *** ' *** 作成者: SAKURI ' *** 作成日: 2015/08/09 ' *** ' ************************************************************************************************ Option Explicit '「表示クリア」ボタン押下後の処理 Private Sub btnClear_Click() '選択した列の内容をクリア Range("A5:XFD1048576").ClearContents Range("A5:XFD1048576").ClearFormats 'セルA5の選択(複数セル選択した選択範囲のクリアのため) Range("A5:A5").Select End Sub '「集計」ボタン押下後の処理 Private Sub btnData_Click() On Error GoTo ERR_HANDLER Dim OraSession As Object 'セッション Dim OraDatabase As Object 'データベース Dim rs As Object 'データセット(レコードセット) Dim i As Long Dim rownum As Long Dim colnum As Integer Dim strSQL As String 'SQL文 Dim maxrownum As Long Dim maxcolnum As Long Dim ws As Worksheet Dim setSheet As Worksheet Dim flag As Boolean 'セッションオブジェクトの生成 Set OraSession = CreateObject("OracleInProcServer.XOraSession") 'データベースオブジェクトの生成(接続先を指定) Set OraDatabase = OraSession.OpenDatabase("XE", "hr/hr", 0&) 'すでに表示されている内容のクリア Call btnClear_Click 'SQL文 strSQL = "select * from EMPLOYEES" 'SQLを実行してデータを取得 Set rs = OraDatabase.CreateDynaset(strSQL, 0&) '列名の表示 rownum = 5 colnum = 1 For i = 0 To rs.Fields.Count - 1 ActiveSheet.Cells(rownum, colnum) = rs(i).Name colnum = colnum + 1 Next 'データの表示(取得したデータを1行ずつExcelに転記) rownum = 6 Do Until rs.EOF colnum = 1 For i = 0 To rs.Fields.Count - 1 ActiveSheet.Cells(rownum, colnum) = rs(i).Value colnum = colnum + 1 Next rs.MoveNext rownum = rownum + 1 Loop '何行何列目まで表示したか保存 maxrownum = rownum - 1 maxcolnum = colnum - 1 '枠線つける Range(Cells(5, 1), Cells(maxrownum, maxcolnum)).Borders.LineStyle = xlContinuous 'セル幅自動調整 Range(Cells(5, 1), Cells(maxrownum, maxcolnum)).Columns.AutoFit 'タイトルに色付け Range(Cells(5, 1), Cells(5, maxcolnum)).Interior.Color = RGB(197, 217, 241) 'ADD 2015/08/09 START------------------------------------------------ Set setSheet = ActiveWorkbook.Worksheets("社員マスタ") '集計シートがあるかどうかチェック For Each ws In Worksheets If ws.Name = "集計" Then flag = True Next ws If flag = True Then '集計シートをActiveにする ActiveWorkbook.Worksheets("集計").Activate '内容を削除 With ActiveSheet Application.DisplayAlerts = False If .PivotTables.Count >= 1 Then .Delete End If Application.DisplayAlerts = True End With End If '集計シート作成 Worksheets.Add ActiveSheet.Name = "集計" 'ピボットを作成 ActiveWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:="社員マスタ!R5C1:R" & maxrownum & "C" & maxcolnum, _ Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="集計!R3C1", _ TableName:="ピボットテーブル1", _ DefaultVersion:=xlPivotTableVersion14 Sheets("集計").Select '行ラベル設定 With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("DEPARTMENT_ID") .Orientation = xlRowField .Position = 1 End With With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("FIRST_NAME") .Orientation = xlRowField .Position = 2 End With '値欄設定と集計方法設定 ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("SALARY"), "合計 / SALARY", xlSum '表示名変更 ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("合計 / SALARY").Caption = "SALARY(SUM)" 'ピボットフィールドリスト非表示 ActiveWorkbook.ShowPivotTableFieldList = False 'レポートレイアウト表形式 ActiveSheet.PivotTables("ピボットテーブル1").RowAxisLayout xlTabularRow 'プラスボタン非表示 ActiveSheet.PivotTables("ピボットテーブル1").ShowDrillIndicators = False 'ピボットスタイル淡色9 ActiveSheet.PivotTables("ピボットテーブル1").TableStyle2 = "PivotStyleLight9" 'タイトル設定 ActiveSheet.Range("A1:A1").Select ActiveSheet.Cells(1, 1) = "部署別給与集計" ActiveSheet.Range("A1").Font.Bold = True ActiveSheet.Range("A1").Font.Italic = True 'ADD 2015/08/09 END------------------------------------------------ 'オブジェクトのクローズ rs.Close '各種オブジェクトの開放 Set rs = Nothing Set OraDatabase = Nothing Set OraSession = Nothing MsgBox ("ヾ(●´∀`●) デキタヨー♪") QUIT_OPER: 'オブジェクト変数用に確保したメモリの開放 Set rs = Nothing Set OraDatabase = Nothing Set OraSession = Nothing Exit Sub ERR_HANDLER: 'エラー処理 'エラー番号とエラー内容の表示 MsgBox Err.Number & ")" & Err.Description Err.Clear GoTo QUIT_OPER End Sub
以下のGitHubに[Pivot.xlsm]というファイル名でコミットしてあります。github.com