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