VBA100本ノック 97本目：Accessデータを取得（グループ集計）

公開日：2021-02-27　最終更新日：2021-03-04

VBA100本ノック 97本目：Accessデータを取得（グループ集計）

Accessからデータを取得（グループ集計）する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 97本目
DB1.accdbから取引先&商品で集計出力する。
■出力項目
取引先CD,取引先名,商品CD,商品名,数量合計,金額合計,平均単価,標準単価,最低単価
平均単価は金額/数量(整数に丸め)
最低単価は全取引先での商品の最低単価
■抽出条件
平均単価 > 標準単価
※シートは任意

96本目と同じデータを使います。
サンプルファイルです。
https://excel-ubara.com/vba100sample/DB1.accdb
https://excel-ubara.com/vba100sample/DB1.xlsx
https://excel-ubara.com/vba100sample/VBA100_96.zip
xlsxはaccdbをExcelにしたものです。
zipには両方入っています。

1回のSQLだけで出来なければ、複数回に分けても構いません。
時にはそういう工夫をすることも大切です。
もちろん1発で済めばそれに越したことはありませんが。

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

ADOについては前回の96本目と同じですので、SQL部分について簡単に。
悩ましい部分は「最低単価」でしょうか。
これには最低単価だけを求めるサブクエリを作成して対応します。
そのサブクエリを他のマスタ同様にJOINすれば完成します。
また、GROUPの結果に対して絞り込む場合はHAVINGを使います。


  
    
      Function createSql(Optional ByVal isExcel As Boolean = False) As String

　　Dim sql() As String: ReDim sql(0)

　　

　　sqlAppend sql, " SELECT"

　　sqlAppend sql, " T1.取引先CD"

　　sqlAppend sql, ",M1.取引先名"

　　sqlAppend sql, ",T1.商品CD"

　　sqlAppend sql, ",M2.商品名"

　　sqlAppend sql, ",SUM(T1.数量) AS 数量合計"

　　sqlAppend sql, ",SUM(T1.数量 * T1.単価) AS 金額合計"

　　sqlAppend sql, ",ROUND(SUM(T1.数量 * T1.単価) / SUM(T1.数量),0) AS 平均単価"

　　sqlAppend sql, ",M2.標準単価"

　　sqlAppend sql, ",S1.最低単価"

　　

　　sqlAppend sql, " FROM ((([T売上] T1"

　　sqlAppend sql, " LEFT JOIN [M取引先] AS M1 ON T1.取引先CD = M1.取引先CD)"

　　sqlAppend sql, " LEFT JOIN [M商品] AS M2 ON T1.商品CD = M2.商品CD)"

　　sqlAppend sql, " LEFT JOIN (SELECT 商品CD,MIN(単価) AS 最低単価"

　　sqlAppend sql, "　　　　　　FROM [T売上]"

　　sqlAppend sql, "　　　　　　GROUP BY 商品CD) AS S1"

　　sqlAppend sql, "　　　　　　ON T1.商品CD = S1.商品CD)"

　　

　　sqlAppend sql, " GROUP BY T1.取引先CD,M1.取引先名,T1.商品CD,M2.商品名,M2.標準単価,S1.最低単価"

　　sqlAppend sql, " HAVING ROUND(SUM(T1.数量 * T1.単価) / SUM(T1.数量),0) > M2.標準単価"

　　

　　createSql = Join(sql)

　　

　　If isExcel Then

　　　　createSql = Replace(createSql, "[T売上]", "[T売上$] ")

　　　　createSql = Replace(createSql, "[M取引先]", "[M取引先$] ")

　　　　createSql = Replace(createSql, "[M商品]", "[M商品$] ")

　　End If

End Function

さらに一段上のクエリを作成すれば、
HAVINGを使わずにWHEREで絞り込めます。
さらに「最低単価」も一段上のクエリでJOINすることもできます。
このSQLと全VBAおよび若干の追加説明を記事補足に記載しました。

補足

全VBAコード


  
    
      Option Explicit


Sub VBA100_97_01()

　　Dim ws As Worksheet: Set ws = Worksheets("売上")

　　Dim sDb As String

　　

　　sDb = ThisWorkbook.Path & "\DB1.accdb" '"\DB1.xlsx"

　　Call VBA100_97_ADO(sDb, ws)

End Sub


Sub VBA100_97_ADO(ByVal aDb As String, ws As Worksheet)

　　Dim adoCn As New ADODB.Connection

　　Dim adoRs As ADODB.Recordset

　　Dim sSql As String, isExcel As Boolean

　　

　　Set adoCn = getConnection(aDb, isExcel)

　　adoCn.Open aDb

　　Set adoRs = adoCn.Execute(createSql(isExcel))

　　

　　Call outputSheet(ws, adoRs)

　　

　　adoRs.Close: Set adoRs = Nothing

　　adoCn.Close: Set adoCn = Nothing

End Sub


Function getConnection(ByVal aDb As String, ByRef isExcel As Boolean) As ADODB.Connection

　　Dim adoCn As New ADODB.Connection

　　Select Case Mid(aDb, InStrRev(aDb, ".") + 1)

　　　　Case "accdb"

　　　　　　With adoCn

　　　　　　　　.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="

　　　　　　End With

　　　　　　isExcel = False

　　　　Case "xlsx", "xlsm"

　　　　　　With adoCn

　　　　　　　　.Provider = "Microsoft.ACE.OLEDB.12.0"

　　　　　　　　.Properties("Extended Properties") = "Excel 12.0"

　　　　　　End With

　　　　　　isExcel = True

　　End Select

　　Set getConnection = adoCn

End Function


Sub outputSheet(ByVal ws As Worksheet, adoRs As ADODB.Recordset)

　　Dim i As Long

　　With ws

　　　　.Cells.Clear

　　　　For i = 0 To adoRs.Fields.Count - 1

　　　　　　.Cells(1, i + 1) = adoRs.Fields(i).Name

　　　　Next

　　　　.Range("A2").CopyFromRecordset adoRs

　　　　.Columns("E:I").NumberFormatLocal = "#,##0"

　　　　.Range("A1").CurrentRegion.EntireColumn.AutoFit

　　End With

End Sub


Function createSql(Optional ByVal isExcel As Boolean = False) As String

　　Dim sql() As String: ReDim sql(0)

　　

　　sqlAppend sql, " SELECT"

　　sqlAppend sql, " T1.取引先CD"

　　sqlAppend sql, ",M1.取引先名"

　　sqlAppend sql, ",T1.商品CD"

　　sqlAppend sql, ",M2.商品名"

　　sqlAppend sql, ",SUM(T1.数量) AS 数量合計"

　　sqlAppend sql, ",SUM(T1.数量 * T1.単価) AS 金額合計"

　　sqlAppend sql, ",ROUND(SUM(T1.数量 * T1.単価) / SUM(T1.数量),0) AS 平均単価"

　　sqlAppend sql, ",M2.標準単価"

　　sqlAppend sql, ",S1.最低単価"

　　

　　sqlAppend sql, " FROM ((([T売上] T1"

　　sqlAppend sql, " LEFT JOIN [M取引先] AS M1 ON T1.取引先CD = M1.取引先CD)"

　　sqlAppend sql, " LEFT JOIN [M商品] AS M2 ON T1.商品CD = M2.商品CD)"

　　sqlAppend sql, " LEFT JOIN (SELECT 商品CD,MIN(単価) AS 最低単価"

　　sqlAppend sql, "　　　　　　FROM [T売上]"

　　sqlAppend sql, "　　　　　　GROUP BY 商品CD) AS S1"

　　sqlAppend sql, "　　　　　　ON T1.商品CD = S1.商品CD)"

　　

　　sqlAppend sql, " GROUP BY T1.取引先CD,M1.取引先名,T1.商品CD,M2.商品名,M2.標準単価,S1.最低単価"

　　sqlAppend sql, " HAVING ROUND(SUM(T1.数量 * T1.単価) / SUM(T1.数量),0) > M2.標準単価"

　　

　　createSql = Join(sql)

　　

　　If isExcel Then

　　　　createSql = Replace(createSql, "[T売上]", "[T売上$] ")

　　　　createSql = Replace(createSql, "[M取引先]", "[M取引先$] ")

　　　　createSql = Replace(createSql, "[M商品]", "[M商品$] ")

　　End If

End Function


Sub sqlAppend(ByRef sql, ByVal aString As String)

　　ReDim Preserve sql(1 To UBound(sql) + 1)

　　sql(UBound(sql)) = aString & vbCrLf

End Sub

GROUP BYについて

GROUP BYで指定したカラム（列名）以外のカラムはSELECTで指定できません。
つまり、集計関数を使わないカラムをSELECTに指定する場合は、GROUP BYにも必ず指定することになります。
※ただし一部のデータベースでは、この制約がない場合もあります。

最低単価のサブクエリ

クエリの結果は1つのテーブルとして考えます（扱えます）。
最低単価を求めるクエリだけを作るのは比較的簡単です。

SELECT 商品CD,MIN(単価) AS 最低単価 FROM T売上 GROUP BY 商品CD

これを括弧()で囲って1つのテーブルとしてJOINすれば良いという事です。

HAVINGについて

GROUP BYで集計した結果に対して絞り込む場合はWHEREではなくHAVINGを使います。
HAVINGはGROUP BYより後ろに記述してください。
各区の順番は以下のようになります。

SELECT
FROM
WHERE
GROUP
HAVING
ORDER

サブクエリの仕組みを使えばGROUP集計の結果をWHEREでも絞り込みできます。
一段上のクエリを作成して、そこで、
・最低単価
・平均単価 > 標準単価
この2点を処理するようにしたものが以下のSQLになります。

先のSQLと対比しやすいように、記述を極力同じようにして残しています。
ぜひ見比べて、処理の違いを確認してみてください。


  
    
      Function createSql(Optional ByVal isExcel As Boolean = False) As String

　　Dim sql() As String: ReDim sql(0)

　　

　　sqlAppend sql, "SELECT G1.*,S1.最低単価 FROM"

　　

　　sqlAppend sql, "(SELECT"

　　sqlAppend sql, " T1.取引先CD"

　　sqlAppend sql, ",M1.取引先名"

　　sqlAppend sql, ",T1.商品CD"

　　sqlAppend sql, ",M2.商品名"

　　sqlAppend sql, ",SUM(T1.数量) AS 数量合計"

　　sqlAppend sql, ",SUM(T1.数量 * T1.単価) AS 金額合計"

　　sqlAppend sql, ",ROUND(SUM(T1.数量 * T1.単価) / SUM(T1.数量),0) AS 平均単価"

　　sqlAppend sql, ",M2.標準単価"

　　sqlAppend sql, " FROM (([T売上] T1"

　　sqlAppend sql, " LEFT JOIN [M取引先] AS M1 ON T1.取引先CD = M1.取引先CD)"

　　sqlAppend sql, " LEFT JOIN [M商品] AS M2 ON T1.商品CD = M2.商品CD)"

　　sqlAppend sql, " GROUP BY T1.取引先CD,M1.取引先名,T1.商品CD,M2.商品名,M2.標準単価"

　　sqlAppend sql, ") AS G1"

　　

　　sqlAppend sql, " LEFT JOIN (SELECT 商品CD,MIN(単価) AS 最低単価"

　　sqlAppend sql, "　　　　　　FROM [T売上]"

　　sqlAppend sql, "　　　　　　GROUP BY 商品CD) AS S1"

　　sqlAppend sql, "　　　　　　ON G1.商品CD = S1.商品CD"

　　sqlAppend sql, " WHERE G1.平均単価 > G1.標準単価"

　　

　　createSql = Join(sql)

　　

　　If isExcel Then

　　　　createSql = Replace(createSql, "[T売上]", "[T売上$] ")

　　　　createSql = Replace(createSql, "[M取引先]", "[M取引先$] ")

　　　　createSql = Replace(createSql, "[M商品]", "[M商品$] ")

　　End If

End Function

ADOについては、関連ページおよび96本目の解説をご覧ください。
96本目：Accessからデータを取得1

・出題・頂いた回答・解説・補足・サイト内関連ページ

サイト内関連ページ

ADO(ActiveX Data Objects)の使い方の要点

・データベースの種類・SQL（SQL:Structured Query Language）・ADOを使う準備・ADOでのDB接続方法・ADODB.Recordsetの取得方法・ADODBのレコードセットの扱い方・ADODBのトランザクション処理・ADODB.Commandの使い方・VBA100本ノックでの実践例・最後に注意点等

VBAでのSQLの基礎（SQL:Structured Query Language）

・SQL文・SELECT文・SQLの学習について・実践例

SQL入門：VBAでデータベースを使う

・DBとはSQLとは・SQL入門の目次・SQLを使った既存サンプル

同じテーマ「VBA100本ノック」の記事

94本目：表範囲からHTMLのtableタグを作成
 95本目：図形のテキストを検索するフォーム作成
 96本目：Accessデータを取得（マスタ結合&抽出）
97本目：Accessデータを取得（グループ集計）
98本目：席替えルールが守られているか確認
 99本目：自動席替え（行列と前後左右が全て違うように）
100本目：WEBから100本ノックのリストを取得
 魔球編：組み合わせ問題
 魔球編：閉領域の塗り潰し
 迷宮編：巡回セル問題
 魔球編：2桁の最小公倍数

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ひらがな⇔カタカナの変換｜エクセル基本操作
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.条件分岐（Select Case）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
97本目：Accessデータを取得（グループ集計）

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 97本目：Accessデータを取得（グループ集計）