Excel VBA でExcelシートのデータをSQL文で条件指定（where）しデータ抽出（select）と集計（sum group by）して結果を出力するサンプル

2023.10.05
DEVELOP
VBA

1. Excel シートのデータをSQL文でデータ抽出とサマリーするVBA

Excel シートのデータをSQL文でデータ抽出とサマリーするVBA

今回は画面の指定条件（年月）で作業日報データ（単一シート）より指定された条件（年月）に合致する日報データをSQL文で抽出する、抽出は年月、名前でGROUP BYし、作業時間を集計して、集計用シートに出力するサンプル。

サンプルでは、

条件シート（INPUT）：条件項目と実行ボタン
日報シート（INPUT）：作業日報の入力用データ
集計１シート（OUTPUT）：集計して出力するシート

を用意する。

条件シートのイメージ

次に作業日報シートのイメージ

実行ボタン（go1）をクリックイベントで実行するVBAコード。

Private Sub Go1_Click()

    '外部ライブラリからインスタンスを作成（実行時バインディング）
    Dim cn As Object
    Dim rs As Object
    Dim w_ym As String
    Dim w_sheetnm As String
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    'ADO接続
    cn.Provider = "Microsoft.ACE.OLEDB.12.0"
    cn.Properties("Extended Properties") = "Excel 12.0"
    cn.Open ThisWorkbook.FullName
    
    'チェック
    If Trim(Sheets("条件").Range("E3").Value) = "" Then
        MsgBox "条件の年月を指定してください。"
        Exit Sub
    End If
    
    '条件セット
    w_ym = Format(Trim(Sheets("条件").Range("E3").Value), "YYYYMM")
    
    '[集計1] 年月、名前、PJコード 毎に集計
    Sql = "SELECT"
    Sql = Sql & " format(a.日付,'YYYYMM') as 年月, a.名前,  COUNT(*) AS 件数, SUM(a.作業時間) AS 作業時間"
    Sql = Sql & " FROM [日報$] as a"
    Sql = Sql & " WHERE a.名前 IS NOT NULL"
    Sql = Sql & "    AND format(a.日付,'YYYYMM') = '" & w_ym & "'"
    Sql = Sql & "  GROUP BY format(a.日付,'YYYYMM'), a.名前"
    Sql = Sql & "  ORDER BY format(a.日付,'YYYYMM'), a.名前"
    rs.Open Sql, cn

    w_sheetnm = "集計1"
    ' 表示データクリア
    Sheets(w_sheetnm).Range("A1:F10000").Value = ""
    curRow = 1
    Sheets(w_sheetnm).Range("A" & curRow).Value = "年月"
    Sheets(w_sheetnm).Range("B" & curRow).Value = "名前"
    Sheets(w_sheetnm).Range("C" & curRow).Value = "件数"
    Sheets(w_sheetnm).Range("D" & curRow).Value = "作業時間"
    
    curRow = curRow + 1
    Do Until rs.EOF
        Sheets(w_sheetnm).Range("A" & curRow).Value = rs!年月
        Sheets(w_sheetnm).Range("B" & curRow).Value = rs!名前
        Sheets(w_sheetnm).Range("C" & curRow).Value = rs!件数
        Sheets(w_sheetnm).Range("D" & curRow).Value = rs!作業時間
        
        rs.MoveNext
        curRow = curRow + 1
    Loop
    rs.Close


    MsgBox "集計処理を終了しました。" & vbCrLf & vbCrLf & "※集計シートを確認してください。", vbOKOnly + vbInformation, "正常終了"
 
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    
End Sub

集計（OUTPUT）シートのイメージ