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

VBAを100本の練習問題で鍛えます
公開日:2021-02-27 最終更新日:2021-03-04

VBA100本ノック 97本目:Accessデータを取得(グループ集計)


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


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック

マクロ VBA 100本ノック


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桁の最小公倍数


新着記事NEW ・・・新着記事一覧を見る

ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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



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