ACCESS VBAでDlookupとDminを使用して商品サイズに応じた梱包材を取得する方法は？

質問

• ACCESSで通信販売のための商品管理と発送システムを作り運用しています。今回、商品のサイズをもとに梱包用の段ボールの種類を自動で取得したいと考えています。具体的には、商品の三辺のサイズを入力後に、商品サイズより大きくかつ一番軽い梱包材を取得したいです。
• T商品テーブルには、商品ID、商品名、サイズW、サイズD、サイズHなどのフィールドがあります。T梱包材マスターテーブルには、梱包材ID、梱包材名、内寸1、内寸2、内寸3、内寸三辺合計、梱包材重量などのフィールドがあります。
• DMin関数を使用して、商品のサイズより大きくかつ一番軽い梱包材IDを取得することができます。具体的なVBAコードは、DMin("梱包材ID", "T梱包材マスター", "内寸1 > " & Me.W & " And " & "内寸2 > " & Me.D & " And " & "内寸3 > " & Me.H)です。このコードでは、T梱包材マスターの内寸1、内寸2、内寸3を商品のサイズと比較し、条件に合致する最小の梱包材IDを取得します。

回答No.4

山田 太郎（@f_a_007）

＞SizeW < 内寸1
＞SizeD < 内寸2
＞SizeH < 内寸3
＞をすべてクリアした段ボールの中で一番軽い箱のIDを取得がしたいです。

SELECT TOP 1 * FROM 梱包材台帳
　　WHERE (内寸1>18 AND 内寸2>19 AND 内寸3>20)
　　ORDER BY 重量

となりますが・・・。ただ・・・。

SELECT TOP 1 * FROM 梱包材台帳
　　WHERE (内寸1>18 AND 内寸2>19 AND 内寸3>20)
　　　　　　　　OR
　　　　　　　 (内寸1>19 AND 内寸2>18 AND 内寸3>20)
　　ORDER BY 重量

と、天地は厳守で左右と奥行とはどちらに合致してもOKなのでは？？？？？

Q、上記のようなSQLを書く場合どこに書くものなのでしょうか？
A、通常はイベントプロシージャに書くことになるかと思います。

例えば、添付図のようなフォームだと仮定すると・・・。

１、幅、奥行、天地の寸法を入力する。
２、選択オプションは、キッチリとユトリの二つ。
３、検索結果はリストボックスに表示する。

テストでは、10×10×10に合致するユトリサイズを表示すると共に選択しています。このフォームのコードは次のようです。

Option Compare Database
Option Explicit

Private Sub Form_Load()

End Sub

Private Sub sizeD_AfterUpdate()
　　DoSelect
End Sub

Private Sub sizeH_AfterUpdate()
　　DoSelect
End Sub

Private Sub sizeW_AfterUpdate()
　　DoSelect
End Sub

Private Sub DoSelect()
　　Dim intW As Integer
　　Dim intD As Integer
　　Dim intH As Integer
　　Dim strSQL As String

　　intW = Val(Me.sizeW & "")
　　intD = Val(Me.sizeD & "")
　　intH = Val(Me.sizeH & "")
　　If intW * intD * intH > 0 Then
　　　　'
　　　　' SQL文の基本形
　　　　'
　　　　strSQL = "SELECT TOP 2 * FROM 梱包材台帳 WHERE " & _
　　　　　　　　 "内寸1> WWWWW AND 内寸2> DDDDD AND 内寸3> HHHHH " & _
　　　　　　　　 "ORDER BY 重量"
　　　　'
　　　　' SQL文のWWWWW、DDDDD、HHHHHを入力値と置換
　　　　'
　　　　strSQL = Replace(strSQL, "WWWWW", Trim(intW))
　　　　strSQL = Replace(strSQL, "DDDDD", Trim(intD))
　　　　strSQL = Replace(strSQL, "HHHHH", Trim(intH))
　　　　'
　　　　' リストボックスに該当する梱包材料のトップ２を表示
　　　　'
　　　　Me.リスト_該当する梱包材料.RowSource = DBSelect(strSQL)
　　　　'
　　　　'　オプションによって選択する材料を決定
　　　　'
　　　　Me.リスト_該当する梱包材料.Value = Me.選択オプション
　　End If
End Sub

なお、ここではVBAを簡略化するために自作のDBSelect()を用いています。また、その兼ね合いでリストボックスのタイプは”リスト”にしています。

【選択オプションと求める答えとの関係】

ここでは、一応、リストボックスの値が求めるものになるようにしています。そうすることで２番目を求めるというSQL文の作成を回避しています。ユーザーには、キッチリとユトリとの双方は目で確認できるので、それで良いという考えです。

PS、DBSelect()

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional colDelimita As String = ";", _
　　　　　　　　　　　　 Optional rowDelimita As String = ";") As String
On Error GoTo Err_DBSelect
　　Dim i　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer ' 行インデックス
　　Dim N　　　　　 As Integer ' 行総数 - 1
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　' 全てのデータを区切子で連結して格納

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　N = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To N
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Mid(strList, 1, Len(strList) - 1) & rowDelimita
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr(13) & Chr(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function