ＡＣＣＥＳＳを活用して商品変動を捉えたい(6再再）

クエリー１４
http://oshiete.goo.ne.jp/qa/8781488.html

を参考にSELECT構文を作っていますが、、、

上記URLの画面のようには出ず、以下のようになります。

※商品名、商品コードが変わらない「大島太陽」も抽出される（数量、価格が変化しているだけ）　※



前回受注日切り替え受注日氏名会員番号商品コード商品名数量価格
2014/04/01山田花子1234567855555魔法瓶12980
2014/04/01302014/05/01山田花子1234567833333御茶碗11280
2014/05/01752014/07/15山田花子1234567822222洗面器1980
2014/04/02大島太陽3456789055555魔法瓶12980
2014/04/02422014/05/14大島太陽3456789055555魔法瓶25960



クエリー14のイメージで間違えないでしょうか。

SELECT DBLookup("SELECT 受注日 FROM 受注履歴 WHERE 会員番号=" & [会員番号] & " AND 受注日 < #" & [受注日] & "# ORDER BY 受注日 DESC") AS 前回受注日, DateDiff("d",前回受注日,受注日) AS 切り替え, *
FROM 受注履歴
WHERE (((DBLookup("SELECT COUNT(受注日) FROM 受注履歴 WHERE 会員番号=" & [会員番号]))>1))
ORDER BY 受注履歴.会員番号, 受注履歴.受注日;

No.1 回答者： f_a_007 回答日時： 2014/10/08 21:32

添付図のような結果を欲しているということですか？

この回答への補足

NO.2が理想なのですが、例えば大島太郎が商品番号、商品名を同じにしても、
表示されます。

商品番号＆商品名がかわったものだけを表示させたい。

補足日時：2014/10/09 10:07

No.2 回答者： f_a_007 回答日時： 2014/10/08 22:15

どうも私が質問内容を理解していませんね。

現状では、添付図のように表示されていますよね。
で、これがダメ！

ということですか？

だとすると、多分、お手上げです。

この回答への補足

商品コード＆商品番号かわった分だけを表示させたいのです！

※商品スイッチを探りたい※


ここでいうと山田花子だけが対象です。

補足日時：2014/10/09 09:08

この回答へのお礼

大島太陽は、商品コード、商品名を同じにしても表示されます。

お礼日時：2014/10/09 09:57

No.3 回答者： f_a_007 回答日時： 2014/10/09 10:02

そういう場合、まず、対象となるデータを一時テーブルに抜き出すとよいでしょう。

A4に出力しても余白だらけというコードで可能かと思いますよ。

会員番号、受注日、商品コードでソートしてから条件に合致する行のみ一時レコードへ。

鈴木一郎　お茶椀　〇
鈴木一郎　洗面器　〇
鈴木一郎　洗面器　〇
鈴木一郎　魔法瓶　〇
鈴木一郎　洗面器　〇
鈴木一郎　洗面器　×
鈴木一郎　洗面器　×

この〇のみ一時レコードへ。

この判定を組み込んだSQLの捻出に３日も４日も費やすぐらいならば、一時テーブルを作成して終わり。

私が思うに、パッと考えてパッと思いつく手法に終始。誰もが理解でき誰も実践できるシンプルな手法でいいじゃーないですか・・・。

この回答への補足

ありがとうございます。一時テーブル作成でいいとおもうのですが（一発では難しそうなので）、



受注日氏名会員番号商品コード商品名数量価格
2014/04/01山田花子1234567855555魔法瓶12980
2014/04/02大島太陽3456789055555魔法瓶12980
2014/05/01山田花子1234567833333御茶碗11280
2014/05/14大島太陽3456789055555魔法瓶25960
2014/07/15山田花子1234567822222洗面器1980
2014/08/19佐藤一郎5678987011111お箸1580
2014/09/10佐藤一郎5678987011111お箸1580

上記から、
以下だけを抜き出す方法はあるのでしょうか？？？？？

受注日氏名会員番号商品コード商品名数量価格
2014/04/01山田花子1234567855555魔法瓶12980
2014/05/01山田花子1234567833333御茶碗11280
2014/07/15山田花子1234567822222洗面器1980

補足日時：2014/10/09 10:15

この回答へのお礼

f_a_007 様


切り替え時期の最終算出は今あるSQL構文で使うと仮定して、

変動したデータを出す方法はあるのでしょうか


変動の考え方は以下と同じ
http://oshiete.goo.ne.jp/qa/8783133.html

お礼日時：2014/10/09 15:27

No.4 回答者： f_a_007 回答日時： 2014/10/09 17:04

もう少し、立ち入った回答を！

添付図を見ますと、目的のデータの抜き出しに（一応は？）成功しています。例え、バグがあっても、プログラムの考え方と構造とは不変な筈です。

さて、その一時テーブルに書き出すコードですが、まあ、もの凄く簡単ですよ。

'
' DELETE 受注履歴一時テーブル
' INSERT INTO 受注履歴一時テーブル VALUES (XXXX, XXXX,…,XXXX)
'
Private Sub コマンド0_Click()
　　Dim I　　　　　　As Integer
　　Dim J　　　　　　As Integer
　　Dim K　　　　　　As Integer
　　Dim L　　　　　　As Integer
　　Dim recTotal　　 As Integer
　　Dim fldTotal　　 As Integer
　　Dim dataValues() As Variant
　　Dim isCheck()　　As Boolean
　　Dim strSQL　　　 As String
　　
　　strSQL = "SELECT * FROM 受注履歴 ORDER BY 会員番号, 受注日"
　　dataValues() = DBSelect(strSQL, "")
　　recTotal = UBound(dataValues, 1) ' 取得したレコード数（ただし、0,1・・・n-1）
　　fldTotal = UBound(dataValues, 2) ' 取得した列数（ただし、0,1・・・n-1）
　　' -------------------------------------
　　'　チェック用変数を準備
　　' -------------------------------------
　　ReDim isCheck(recTotal)
　　' -------------------------------------
　　'　最初に一時テーブルをクリア
　　' -------------------------------------
　　DoCmd.SetWarnings False
　　DoCmd.RunSQL "DELETE FROM 受注履歴一時テーブル"
　　' --------------------------------------
　　'　商品コードが違っているかをテスト
　　' --------------------------------------
　　K = recTotal - 1
　　For I = 0 To K
　　　　L = I + 1
　　　　'
　　　　' dateValues(n, 2)---会員番号
　　　　' dateValues(n, 3)---商品コード
　　　　'
　　　　If dataValues(I, 2) = dataValues(L, 2) Then
　　　　　　If dataValues(I, 3) <> dataValues(L, 3) Then
　　　　　　　　isCheck(I) = True
　　　　　　　　isCheck(L) = True
　　　　　　End If
　　　　End If
　　Next I
　　' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　For I = 0 To recTotal
　　　　If isCheck(I) = True Then
　　　　　　Debug.Print Format(I, "<No.0000> ------------------------------------")
　　　　　　Debug.Print dataValues(I, 0)
　　　　　　Debug.Print dataValues(I, 1)
　　　　　　Debug.Print dataValues(I, 2)
　　　　　　Debug.Print dataValues(I, 3)
　　　　　　Debug.Print dataValues(I, 4)
　　　　End If
　　Next I
End Sub

Debug.Print でイミディエイトウインドウに出力している部分を

INSERT INTO 受注履歴一時テーブル VALUES (dataValues(I, 0),dataValues(I, 1),…,dataValues(I, 6))

とすれば、多分、一時テーブルへの書き出しは成功します。

こういう手法でよければ、肝心かなめの DBSelect() を補足します。

この回答への補足

DBSelect()で検討します。

補足日時：2014/10/09 19:07

この回答へのお礼

ありがとうございます。こんなに盛りだくさん。
ほんとに深いですね。


参考にしながら動き見てみます。

お礼日時：2014/10/09 19:05

No.5 回答者： f_a_007 回答日時： 2014/10/09 18:26

＞超簡単に目的のレコードを一時テーブルに抜き出せる！

そのためには、SQL文の実行結果を２次元配列で戻す関数が必要です。その手続きが関数化されているので、後は、取得した配列の前後で、同じお客であり、かつ、商品が違っているかを判定するだけ。判定後は、真のレコードだけ　Insert文で挿入すれば目的は達成できます。

さて、問題の DBSelect()ですが、それは二番目の引数があるか否かで戻す値が違います。

DBSelect("SELECT 受注日, 氏名, 商品名 FROM 受注履歴", ";")
　↓
戻り値=(;)等で連結した文字列

DBSelect("SELECT 受注日, 氏名, 商品名 FROM 受注履歴")
　↓
戻り値=dataValue(レコード数, 列数)

【DBSelect()】

Public Function DBSelect(ByVal strQuerySQL As String, Optional strPause As String = ";") As Variant
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer　　' DataValue(,) のインデックスを決める行カウンター
　　Dim C　　　　　 As Integer　　' DataValue(,) のインデックスを決める列カウンター
　　Dim M　　　　　 As Integer　　' DataValue(,) の一つ目の添字の最大値=行総数 - 1
　　Dim N　　　　　 As Integer　　' DataValue(,) の二つ目の添字の最大値=列総数 - 1
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　　 ' 全てのデータをセミコロン(;)等で区切った文字列に
　　
　　Set rst = New ADODB.Recordset
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　' --------------
　　　　　　'　配列を再宣言
　　　　　　' --------------
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　If M > 99 Then
　　　　　　　　MsgBox "読込む行総数を100行に下方修正しました。(DBSelect)", _
　　　　　　　　　　　 vbInformation, _
　　　　　　　　　　　 " お知らせ"
　　　　　　　　M = 99
　　　　　　End If
　　　　　　ReDim dataValues(M, N)
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　C = C + 1
　　　　　　　　　　　　dataValues(R, C) = .Value
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　ReDim dataValues(0, 0)
　　　　　　dataValues(0, 0) = ""
　　　　　　strList = ""
　　　　End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
　　' -------------------------------
　　'　区切子(;)で連結して１文に
　　' -------------------------------
　　If Len(strPause & "") > 1 Then
　　　　For I = 0 To M
　　　　　　For J = 0 To N
　　　　　　　　strList = strList & dataValues(I, J) & strPause
　　　　　　Next J
　　　　　　strList = strList & Chr(13)
　　　　Next I
　　End If
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strPause & "") > 1, strList, dataValues())
　　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

注意：100行制限をかけています。必要であれば、100→1000と修正するか？などされてください。

No.6 回答者： f_a_007 回答日時： 2014/10/09 22:48

補足：一時テーブルにインサートする

念の為に、実際に一時テーブルに書き込んでみました。結果は、添付図の通りです。

　　' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　For I = 0 To recTotal
　　　　If isCheck(I) = True Then
　　　　　　strSQL = "INSERT INTO 受注履歴一時テーブル VALUES (" & _
　　　　　　　　dataValues(I, 0) & ", " & _
　　　　　　　　"'" & dataValues(I, 1) & "', " & _
　　　　　　　　dataValues(I, 2) & ", " & _
　　　　　　　　dataValues(I, 3) & ", " & _
　　　　　　　　"'" & dataValues(I, 4) & "', " & _
　　　　　　　　dataValues(I, 5) & ", " & _
　　　　　　　　dataValues(I, 6) & ")"
　　　　　　DoCmd.RunSQL strSQL
　　　　End If
　　Next I

一時テーブルに挿入するコードは以上のようになります。

【留意点】

文字列は

"'" & dataValues(I, 1) & "', " & _

仮に、会員番号,商品コードが文字列ですと、'文字列'のSQL文になるようにしなければなりません。

一時テーブルにインサートする部分は、実際にはこのようになります。

No.7 回答者： f_a_007 回答日時： 2014/10/09 22:50

　　' --------------------------------------

　　'　一時テーブルにインサートする
　　' --------------------------------------
　　For I = 0 To recTotal
　　　　If isCheck(I) = True Then
　　　　　　strSQL = "INSERT INTO 受注履歴一時テーブル VALUES (" & _
　　　　　　　　dataValues(I, 0) & ", " & _
　　　　　　　　"'" & dataValues(I, 1) & "', " & _
　　　　　　　　dataValues(I, 2) & ", " & _
　　　　　　　　dataValues(I, 3) & ", " & _
　　　　　　　　"'" & dataValues(I, 4) & "', " & _
　　　　　　　　dataValues(I, 5) & ", " & _
　　　　　　　　dataValues(I, 6) & ")"
　　　　　　DoCmd.RunSQL strSQL
　　　　End If
　　Next I

一時テーブルに挿入するコードは以上のようになります。

【留意点】

文字列は

"'" & dataValues(I, 1) & "', " & _

仮に、会員番号,商品コードが文字列ですと、'文字列'のSQL文になるようにしなければなりません。

一時テーブルにインサートする部分は、実際にはこのようになります。

No.8 回答者： f_a_007 回答日時： 2014/10/09 23:35

お詫び：

×　Len(strPause & "")>1
〇　Len(strPause & "")


　　' ---------------
　　'　End With: rst
　　' ===============
　　' -------------------------------
　　'　区切子(;)で連結して１文に
　　' -------------------------------
　　If Len(strPause & "") Then
　　　　For I = 0 To M
　　　　　　For J = 0 To N
　　　　　　　　strList = strList & dataValues(I, J) & strPause
　　　　　　Next J
　　　　　　strList = strList & Chr(13)
　　　　Next I
　　End If
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strPause & ""), strList, dataValues())
　　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

もう、15年も使用しているDBSelect()。先の回答の際に、なぜか

Len(strPause & "")
　↓
Len(strPause & "")>1

修正。こっれは、全く無用。元に戻して下さい。

で、２番目の引数に "" を指定したら配列、そうでなくて、指定しないときは";"を自動で指定。そういう風に設計していました。

【一時テーブルに追加するコード】

　　' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　For I = 0 To recTotal
　　　　If isCheck(I) = True Then
　　　　　　strSQL = "INSERT INTO 受注履歴一時テーブル VALUES (" & _
　　　　　　　　dataValues(I, 0) & ", " & _
　　　　　　　　"'" & dataValues(I, 1) & "', " & _
　　　　　　　　dataValues(I, 2) & ", " & _
　　　　　　　　dataValues(I, 3) & ", " & _
　　　　　　　　"'" & dataValues(I, 4) & "', " & _
　　　　　　　　dataValues(I, 5) & ", " & _
　　　　　　　　dataValues(I, 6) & ")"
　　　　　　DoCmd.RunSQL strSQL
　　　　End If
　　Next I

ついでに、【一時テーブルに追加するコード】も紹介しておきます。なお、実行結果は添付図のようです。

No.9 ベストアンサー 回答者： f_a_007 回答日時： 2014/10/10 12:27

お詫び：（もう一度）

何か、回答が反映されなくて色々と・・・。で、本当のを！

お詫び：

×　Len(strPause & "")>1
〇　Len(strPause)>0 又は　Len(strPause)

DBSelect()は、回答文にコピペしてから２箇所修正しました。

Len(strPause & "")
　↓
Len(strPause & "")>1

と。これは、もちろん

Len(strPause & "")
　↓
Len(strPause & "")>0

とすべき修正。

その部分を

Len(strPause)

に訂正されて下さい。& "" は不要です。

※※修正箇所１※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
　　If Len(strPause) Then
　　　　For I = 0 To M
※※修正箇所２※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
　　DBSelect = IIf(Len(strPause), strList, dataValues())
※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※

【一時テーブルに追加するコード】

ついでに、示唆に留めておいた＜一時テーブルに追加するコード＞も紹介しておきます。なお、実行結果は添付図のようです。

　　' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　For I = 0 To recTotal
　　　　If isCheck(I) Then
　　　　　　strSQL = "INSERT INTO 受注履歴一時テーブル VALUES (" & _
　　　　　　　　"#" & dataValues(I, 0) & "#, " & _
　　　　　　　　"'" & dataValues(I, 1) & "', " & _
　　　　　　　　dataValues(I, 2) & ", " & _
　　　　　　　　dataValues(I, 3) & ", " & _
　　　　　　　　"'" & dataValues(I, 4) & "', " & _
　　　　　　　　dataValues(I, 5) & ", " & _
　　　　　　　　dataValues(I, 6) & ")"
　　　　　　DoCmd.RunSQL strSQL
　　　　End If
　　Next I

留意点は、SQL文では

日付・時刻型----> #2014/01/01#
文字列型--------> 'TEXT'

と書くことです。会員番号や商品コードが数字でなく文字列であれば、上記では不具合が発生します。例えば、日付が1900年代になるとか・・・・・。

この回答へのお礼

ありがとうございます。なかなか入り組んでいるようなので整理してみます。

取り急ぎお礼まで（今日中に検証しようと思っています）。


技術がいるんですね。

お礼日時：2014/10/10 15:54