テスト113

Sub SQL_Proc()
'-----------------------------
'参照設定
'Microsoft ActiveX Data Objects 6.1 Library
'Excel内で4つのシートを元にクロス集計を使ったSQLサンプル
'クロス集計で得意先別商品別売上集計表を作る....〆('ω' )
'-----------------------------
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim i As Long
Dim Output_Sh As Worksheet
Dim str_SQL As String
Dim Field_Name As Variant

Set Output_Sh = ThisWorkbook.Sheets("出力先")
Set CN = New ADODB.Connection
Set RS = New ADODB.Recordset

CN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=" & ThisWorkbook.FullName & ";" & _
               "Extended Properties='Excel 12.0;HDR=YES' "

str_SQL = "TRANSFORM Sum([単価]*[数量]) AS 金額 " & _
                 "SELECT A.商品名 " & _
                 "FROM [T_商品マスター$] AS A INNER JOIN " & _
                     "([T_得意先マスター$] AS B INNER JOIN ([Ｔ_売上伝票$] AS C INNER JOIN " & _
                                                          "[T_売上明細$] AS D " & _
                                                          "ON C.伝票番号 = D.伝票番号) " & _
                     "ON B.得意先コード = C.得意先コード) " & _
                 "ON A.商品コード = D.商品コード " & _
                 "GROUP BY A.商品名 " & _
                 "PIVOT B.得意先名; "

'クロス集計を実行
Set RS = CN.Execute(str_SQL)

i = 1

'集計結果を[出力先]シートへ出力する
With Output_Sh

    .Cells.Clear
    
    For Each Field_Name In RS.Fields
    
        .Cells(1, i).Value = Field_Name.Name
        i = i + 1
    
    Next Field_Name
    
    .Range("A2").CopyFromRecordset RS

    .Columns.AutoFit
    
End With

Set RS = Nothing
Set CN = Nothing

MsgBox "処理が終了しました。", vbInformation

'○完成イメージ
'            得意先名1   得意先名2   得意先名3   得意先名4   得意先名5
'商品名1
'商品名2
'商品名3
'商品名4
'商品名5
'商品名6
'商品名7

End Sub