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を使った既存サンプル

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

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

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

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

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

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

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

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