EXCEL VBAでSQL文を使って集計する。複数ブック対応案

EXCEL VBAでSQL文を使って集計する　を複数ブックで行う場合を考えてみました。

複数のシートを結合してSQLを発行したい場合に別々のブックであると、コネクションが別々となってしまうため、ひとつのSQLで実行することができません。

そこで今回は、必要なシートをコピーしてきてからSQLを実行するように改良します。

従業員マスタのブック

Sheet1に下記内容でデータを用意し、「EXCELでSQLが使える2-1.xlsx」の名前でマクロブックと同じフォルダに保存します。

EXCEL VBAでSQL文を使って集計する　で利用したマクロブック

Sheet2の集計表に性別と年齢を加えます。

集計ボタンをクリックしたときの処理を改良します

改良済みのVBAです。

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行目

    ' 別ブックからシートをコピー
    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 で結合しました。テーブル名には別名を付けてみました。

    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

    ' 表示データクリア
    Sheets("Sheet2").Range("A10:F100").Value = ""

性別と年齢を出力します。

        Sheets("Sheet2").Range("E" & curRow).Value = rs!性別
        Sheets("Sheet2").Range("F" & curRow).Value = rs!年齢

最後にコピーしたシートを削除します。

    ' コピーしたシートを削除する
     Application.DisplayAlerts = False
     Worksheets("従業員マスタ").Delete
     Application.DisplayAlerts = True

ブックを保存し集計ボタンをクリックして実行します。別ブックは閉じておきます。

性別と年齢が表示されたでしょうか？

最後に

データ量など程度問題だとは思いますが、複数のブックをひとつにまとめてあげることで使い勝手が向上します。

また、別々のブックで管理していても集計時に毎回コピーしてくるため上手く利用すれば便利だと思います。

それから、ここで紹介したVBAではエラー処理など省略していますので、実際に利用する際にはきちんと考えておかないといけません。別ブックが開かれていたらエラーになったりしますので。