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

VBAを100本の練習問題で鍛えます
最終更新日: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発で済めばそれに越したことはありませんが。


頂いた回答

解説

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
Accessからデータを取得(マスタ結合&抽出)する問題です。ツイッター連動企画です。ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。VBAテスト用のサンプルデータは、VBA100本ノックの目次ページからもダウンロードできます。


サイト内関連ページ

ADO(ActiveX Data Objects)の使い方の要点
ADOはMicrosoftが提供するデータベースアクセスのためのソフトウェア部品です。OLEDBをActiveXコントロールの形で使えるようにしたプログラミングインターフェースになります。ここでは、ADOを使用したデータベースへの接続方法を解説します。
VBAでのSQLの基礎(SQL:Structured Query Language)
SQL(StructuredQueryLanguage:構造化問い合わせ言語)は、データベースの定義や表の操作を行う言語です。データ定義言語であるDDL(datadescriptionlanguage)と データ操作言語であるDML(datamanipulationlanguage)に分けられます。
SQL入門:VBAでデータベースを使う
社会的にパソコンで扱うデータ量は近年急激に増えています。これに呼応してエクセルも2003までは65536行まででしたが、2007から飛躍的に増えて1048576行となっています。しかしエクセルで100万行扱えるといっても、データ量としては列数もありますので、実際には100万行はおろか数十万行でもエクセルが重くなって扱いづらくなってしまいます。




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

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


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

PropertyのSetはLetでも良い|VBA技術解説(2021-03-31)
エクセル麻雀ミニゲーム|VBAサンプル集(2021-03-09)
VBA100本ノック 100本目:WEBから100本ノックのリストを取得|VBA練習問題(2021-03-03)
VBA100本ノック 魔球編:2桁の最小公倍数|VBA練習問題(2021-02-02)
Select Caseでの短絡評価(ショートサーキット)の使い方|VBA技術解説(2021-01-03)
VBA100本ノック 迷宮編:巡回セル問題|VBA練習問題(2020-12-31)
VBA100本ノック 魔球編:閉領域の塗り潰し|VBA練習問題(2020-12-16)
VBA100本ノック 魔球編:組み合わせ問題|VBA練習問題(2020-12-02)
将棋とプログラミングについて~そこには型がある~|エクセル雑感(2020-11-22)
VBA100本ノック 1本目:セルのコピー|VBA練習問題(2020-10-19)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.Excelショートカットキー一覧|Excelリファレンス
6.繰り返し処理(For Next)|VBA入門
7.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
8.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
9.セルに文字を入れるとは(Range,Value)|VBA入門
10.とにかく書いてみよう(Sub,End Sub)|VBA入門




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


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



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