EXCEL VBAでSQL文を使って集計する を複数ブックで行う場合を考えてみました。
複数のシートを結合してSQLを発行したい場合に別々のブックであると、コネクションが別々となってしまうため、ひとつのSQLで実行することができません。
そこで今回は、必要なシートをコピーしてきてからSQLを実行するように改良します。
従業員マスタのブック
Sheet1に下記内容でデータを用意し、「EXCELでSQLが使える2-1.xlsx」の名前でマクロブックと同じフォルダに保存します。
EXCEL VBAでSQL文を使って集計する で利用したマクロブック
Sheet2の集計表に性別と年齢を加えます。
集計ボタンをクリックしたときの処理を改良します
改良済みのVBAです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
Private Sub 集計_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim xl_file As String Dim sql As String Dim curRow As Integer ' 別ブックからシートをコピー Workbooks.Open Filename:=CurDir("D") & "\EXCELでSQLが使える2-1.xlsx" Workbooks("EXCELでSQLが使える2-1.xlsx").Worksheets("Sheet1").Copy After:=ThisWorkbook.Worksheets("Sheet2") Workbooks("EXCELでSQLが使える2-1.xlsx").Close saveChanges:=0 ActiveSheet.Name = "従業員マスタ" 'ツールメニューの参照設定' ' Microsoft ActiveX Data Objects 2.8 Library' 'チェック' xl_file = ThisWorkbook.FullName '他のブックを指定しても良い' 'xl_file = ThisWorkbook.Path & "\一覧表.xlsx" Set cn = New ADODB.Connection cn.Provider = "MSDASQL" #If Win64 Then ' 64bit cn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & "DBQ=" & xl_file & "; ReadOnly=False;" #Else ' 32bit cn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & xl_file & "; ReadOnly=False;" #End If cn.Open Set rs = New ADODB.Recordset sql = "SELECT" _ & " T.名前, COUNT(*) AS 出勤日数, SUM(T.勤務時間) AS 時間計, SUM(T.給料) AS 給料計" _ & " , J.性別, J.年齢" _ & " FROM [Sheet1$] AS T" _ & " INNER JOIN [従業員マスタ$] AS J ON (J.名前=T.名前)" _ & " GROUP BY T.名前, J.性別, J.年齢" _ & " ORDER BY T.名前" rs.Open sql, cn, adOpenStatic ' 表示データクリア Sheets("Sheet2").Range("A10:F100").Value = "" curRow = 10 Do Until rs.EOF Sheets("Sheet2").Range("A" & curRow).Value = rs!名前 Sheets("Sheet2").Range("B" & curRow).Value = rs!出勤日数 Sheets("Sheet2").Range("C" & curRow).Value = rs!時間計 Sheets("Sheet2").Range("D" & curRow).Value = rs!給料計 Sheets("Sheet2").Range("E" & curRow).Value = rs!性別 Sheets("Sheet2").Range("F" & curRow).Value = rs!年齢 rs.MoveNext curRow = curRow + 1 Loop ' コピーしたシートを削除する Application.DisplayAlerts = False Worksheets("従業員マスタ").Delete Application.DisplayAlerts = True End Sub |
ポイント解説
必要なシートが同じブックにあれば、ひとつのSQLで処理出来るようになりますので、準備した別ブックからシートをコピーします。
・別ブックを開きます。私の環境ではDドライブにブックを保存しましたので CurDir("D") としてあります。ファイル名を普通にフルパスで指定してもOKです。下記2行目
・コピーしてくるシートは、このブックの一番後ろにコピーします。下記３行目
・別ブックをセーブせず閉じます。下記４行目
・コピーしたシートは「従業員マスタ」にシート名を変更します。下記5行目
|
1 2 3 4 5 |
' 別ブックからシートをコピー Workbooks.Open Filename:=CurDir("D") & "\EXCELでSQLが使える2-1.xlsx" Workbooks("EXCELでSQLが使える2-1.xlsx").Worksheets("Sheet1").Copy After:=ThisWorkbook.Worksheets("Sheet2") Workbooks("EXCELでSQLが使える2-1.xlsx").Close saveChanges:=0 ActiveSheet.Name = "従業員マスタ" |
SQL文は下記の様にINNNER JOIN で結合しました。テーブル名には別名を付けてみました。
|
1 2 3 4 5 6 7 |
sql = "SELECT" _ & " T.名前, COUNT(*) AS 出勤日数, SUM(T.勤務時間) AS 時間計, SUM(T.給料) AS 給料計" _ & " , J.性別, J.年齢" _ & " FROM [Sheet1$] AS T" _ & " INNER JOIN [従業員マスタ$] AS J ON (J.名前=T.名前)" _ & " GROUP BY T.名前, J.性別, J.年齢" _ & " ORDER BY T.名前" |
クリアする領域を拡張します。A10:D100 から A10:F100
|
1 2 |
' 表示データクリア Sheets("Sheet2").Range("A10:F100").Value = "" |
性別と年齢を出力します。
|
1 2 |
Sheets("Sheet2").Range("E" & curRow).Value = rs!性別 Sheets("Sheet2").Range("F" & curRow).Value = rs!年齢 |
最後にコピーしたシートを削除します。
|
1 2 3 4 |
' コピーしたシートを削除する Application.DisplayAlerts = False Worksheets("従業員マスタ").Delete Application.DisplayAlerts = True |
ブックを保存し集計ボタンをクリックして実行します。別ブックは閉じておきます。
性別と年齢が表示されたでしょうか？
最後に
データ量など程度問題だとは思いますが、複数のブックをひとつにまとめてあげることで使い勝手が向上します。
また、別々のブックで管理していても集計時に毎回コピーしてくるため上手く利用すれば便利だと思います。
それから、ここで紹介したVBAではエラー処理など省略していますので、実際に利用する際にはきちんと考えておかないといけません。別ブックが開かれていたらエラーになったりしますので。