VBA100本ノック 96本目：Accessデータを取得（マスタ結合&抽出）

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

VBA100本ノック 96本目：Accessデータを取得（マスタ結合&抽出）

Accessからデータを取得（マスタ結合&抽出）する問題です。

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

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

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

出題

#VBA100本ノック 96本目
DB1.accdbから以下の出力項目と抽出条件でデータを取得しシートに出力する。
■出力項目
取引先CD,取引先名,商品CD,商品名,単価,数量,金額
金額は単価*数量
■抽出条件
2021年以降(2021/01/01～)
金額が100万以上
※テーブルは画像とサンプルにて
※シートは任意

サンプルファイルです。
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には両方入っています。

ACCESSで複数JOINする場合は、()でまとめたものに対してJOINしていくようにします。
FROM (tablA LEFT JOIN tableB On …) LEFT JOIN tableC ON …
さらに全体を()で囲っても良いです。
FROM ((tablA LEFT JOIN tableB On …) LEFT JOIN tableC ON …)

ACCESSから取得出来たら、それを少しだけ直してExcelからも取得してみると良いと思います。

問題文には「日付」がなくて、出力サンプルには「日付」があり、ずれてしまっていました。
このデータなら「日付」があるのが普通でしょうか。
回答はどちらでも結構です。

VBA作成タイム

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

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

頂いた回答

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

解説

データベース接続には参照設定した上でADOを使用しました。
かなり長くなっていますが、AccessとExcelのどちらでも使えるようにしたり関数化したりしているためです。
何よりSQLを改行して書いているので行数が多くなっています。
SQLは長くなると読みづらくなので、記述方法は考えたいところです。


  
    
      Sub VBA100_96_01()

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

　　Dim sDb As String

　　

　　Const cnsDate As Date = #1/1/2021#

　　Const cnsAmount As Long = 1000000

　　

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

　　Call VBA100_96_ADO(sDb, ws, Array(cnsDate, cnsAmount))

End Sub


Sub VBA100_96_ADO(ByVal aDb As String, ws As Worksheet, ByRef aParam)

　　Dim adoCn As New ADODB.Connection

　　Dim adoRs As ADODB.Recordset

　　Dim isExcel As Boolean

　　

　　Set adoCn = getConnection(aDb, isExcel)

　　adoCn.Open aDb

　　Set adoRs = adoCn.Execute(createSql(aParam, 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

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

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

　　　　Case "accdb"

　　　　　　isExcel = False

　　　　Case "xlsx", "xlsm"

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

　　　　　　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").NumberFormatLocal = "yyyy/mm/dd"

　　　　.Columns("F:H").NumberFormatLocal = "#,##0"

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

　　End With

End Sub


Function createSql(ByRef aParam, 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, ",T1.日付"

　　sqlAppend sql, ",T1.単価"

　　sqlAppend sql, ",T1.数量"

　　sqlAppend sql, ",T1.数量 * T1.単価 AS 金額"

　　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, " WHERE T1.日付 >= #" & Format(aParam(0), "yyyy/mm/dd") & "#"

　　sqlAppend sql, "　 AND T1.数量 * T1.単価 >= " & aParam(1)

　　

　　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

JOINについてはINNERかOUTERかは状況によりますが、今回はどちらでも良いでしょう。
記事には若干の補足とVBAコードを掲載しました。
同じデータで次の問題へ続きます。

補足

上記VBAでは「Microsoft ActiveX Data Objects 6.1 Library」を参照設定しました。

詳細は以下を参照してください。
ADO(ActiveX Data Objects)の使い方の要点

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

"Provider=Microsoft.ACE.OLEDB.12.0"
この部分は、Office2016以降なら、16.0で構いません。

全体の流れ

ADODB.Connection
↓
ConnectionString ・・・ DBにより変える
Properties
↓
Open
↓
ExecuteでSQL発行
↓
Recordsetを処理
↓
Close

角括弧[]について

上記VBAではテーブル名を[]で囲っています。
この主な目的としては、Excelの場合にテーブル名（エクセルのシート）の指定方法が違うので、文字列置換の対象をはっきりさせる為に指定したものですが、
しかし、そもそも[]とは何かと言うことになります。
回答にもテーブル名とフィールド名を[]で囲っているものがあります。
[テーブル名].[列名]

テーブル名や列名が特殊文字を含む場合や予約語の場合に、
Access（SQLServerも同様）では[]で囲むことになっています。
つまり、今回のように特殊文字を含まない場合は無くても構いませんし、[]で囲んでも構いません。

この決まりは、データベースによって違ってきます。
DBによりますが、ダブルクォーテーション(")やバッククォート(`)が使われたりします。

DBとの接続には色々なやり方があります。

頂いた回答で上記とは違う方法での回答ツイートへのリンクを掲載しておきます。

Recordset.Open

https://twitter.com/audiobookrunner/status/1365205651362705415

ADODB.CommandとParameters

https://twitter.com/nukie_53/status/1365290828956979202

DAO(Microsoft DAO X.X Object Library)

https://twitter.com/wakamekiss/status/1365319117742346240

サイト内関連ページ

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

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

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

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

・データベースの必要性と本シリーズの方針・DBとはSQLとは・SQL入門の目次・SQL基礎問題の目次・SQLを使った既存サンプル

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

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
96本目：Accessデータを取得（マスタ結合&抽出）

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

VBA練習問題
VBA100本ノック 96本目：Accessデータを取得（マスタ結合&抽出）