ゆっくり開発

思いついた便利コードを気ままにアップしていきます。公開しているソースコードはすべてMITライセンスです。

【VBA】2つのシートを結合して検索するSQL

■関連情報 - 【VBA】別ファイルのシートコピー

DB関連モジュール

Option Explicit

Private Const DBプロバイダ As String = "Microsoft.ACE.OLEDB.12.0"
Private Const DBプロパティ As String = "Extended Properties"
Private Const DBExcelバージョン As String = "Excel 12.0"

マスターテーブルと明細テーブルから集計テーブルを作成する

Sub 複数シートの集計処理()
    
    On Error GoTo ■エラー処理
    
    Dim DB接続情報 As Object
    Dim 検索結果 As Object
    Dim 行№ As Long
    Dim 列№ As Long
    Dim 項目№ As Long
    Dim SQL文 As String
    
    Call 開始前処理
    
    If 別ブックのシート取込("C:\test\ADO_MASTER.xlsx", "マスター", False) = False Then GoTo ■終了処理
    If 別ブックのシート取込("C:\test\ADO_MEISAI.xlsx", "明細", False) = False Then GoTo ■終了処理
    
    Call DB接続処理(DB接続情報, 検索結果, このブック.FullName)
    
    SQL文 = ""
    SQL文 = SQL文 & " SELECT"
    SQL文 = SQL文 & "   FORMAT(明細.購入日,'yyyy/mm/dd') AS 購入日"
    SQL文 = SQL文 & " , マスタ.商品名 "
    SQL文 = SQL文 & " , 明細.個数 "
    SQL文 = SQL文 & " , マスタ.金額 "
    SQL文 = SQL文 & " , マスタ.金額 * 明細.個数 AS 小計 "
    SQL文 = SQL文 & " FROM"
    SQL文 = SQL文 & "   [明細$C2:F] AS 明細"
'    SQL文 = SQL文 & " INNER JOIN"
'    SQL文 = SQL文 & " RIGHT JOIN"
    SQL文 = SQL文 & " LEFT JOIN"
    SQL文 = SQL文 & "   [マスター$] AS マスタ"
    SQL文 = SQL文 & " ON"
    SQL文 = SQL文 & "   (明細.商品コード=REPLACE(マスタ.商品コード,'.xxxx',''))"
    SQL文 = SQL文 & " WHERE"
    SQL文 = SQL文 & "   FORMAT(明細.購入日,'yyyy')='2020'"
    SQL文 = SQL文 & " ORDER BY"
    SQL文 = SQL文 & "   明細.購入日"
    SQL文 = SQL文 & " , マスタ.商品名"
    
    検索結果.CursorLocation = adUseClient
    検索結果.Open SQL文, DB接続情報, adOpenDynamic, adLockOptimistic, adCmdText
    With 集計シート.ListObjects("集計テーブル")
        If .ListRows.Count > 0 Then
            .DataBodyRange.Delete
        End If
        With .HeaderRowRange(1)
            集計シート.Cells(.Offset(1, 0).Row, .Column).CopyFromRecordset 検索結果
        End With
    End With
    
    Debug.Print "●集計処理の成功●"
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲集計処理のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:
    Call DB切断処理(DB接続情報, 検索結果)
    Call シート削除(Array("マスター", "明細"), このブック)
    Call 終了前処理
    
End Sub
Private Function DB接続処理( _
               ByRef DB接続情報 As Object _
             , ByRef レコードセット As Object _
             , ByRef 接続先ファイルのフルパス As String _
             ) As Boolean
    
    On Error GoTo ■エラー処理
    
    DB接続処理 = False
    
    Set DB接続情報 = CreateObject("ADODB.Connection")
    Set レコードセット = CreateObject("ADODB.Recordset")
    
    With DB接続情報
        .Provider = DBプロバイダ
        .Properties(DBプロパティ) = DBExcelバージョン
        .Open 接続先ファイルのフルパス
    End With
    
    Debug.Print "●DB接続処理の成功●"
    DB接続処理 = True
    
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲DB接続処理のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:

End Function
Private Function DB切断処理( _
                      ByRef DB接続情報 As Object _
                    , ByRef レコードセット As Object _
                    ) As Boolean
    
    On Error GoTo ■エラー処理
    
    DB切断処理 = False
    
    If レコードセット.State = adStateOpen Then レコードセット.Close
    If Not レコードセット Is Nothing Then Set レコードセット = Nothing
    
    If DB接続情報.State = adStateOpen Then DB接続情報.Close
    If Not DB接続情報 Is Nothing Then Set DB接続情報 = Nothing
    
    Debug.Print "●DB切断処理の成功●"
    DB切断処理 = True
    
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲DB切断処理のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:

End Function