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

質問

クエリー１４
http://okwave.jp/qa/q8781488.html

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

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

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

前回受注日 切り替え 受注日 氏名 会員番号 商品コード 商品名 数量 価格
2014/04/01 山田花子 12345678 55555 魔法瓶 1 2980
2014/04/01 30 2014/05/01 山田花子 12345678 33333 御茶碗 1 1280
2014/05/01 75 2014/07/15 山田花子 12345678 22222 洗面器 1 980
2014/04/02 大島太陽 34567890 55555 魔法瓶 1 2980
2014/04/02 42 2014/05/14 大島太陽 34567890 55555 魔法瓶 2 5960

クエリー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.9

山田 太郎（@f_a_007） · ベストアンサー

お詫び：（もう一度）

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

お詫び：

×　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年代になるとか・・・・・。

お礼

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

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

技術がいるんですね。

回答No.8

山田 太郎（@f_a_007）

お詫び：

×　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.7

山田 太郎（@f_a_007）

' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　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.6

山田 太郎（@f_a_007）

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

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

　　' --------------------------------------
　　'　一時テーブルにインサートする
　　' --------------------------------------
　　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.5

山田 太郎（@f_a_007）

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

そのためには、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.4

山田 太郎（@f_a_007）

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

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

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

'
' 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()で検討します。

回答No.3

山田 太郎（@f_a_007）

そういう場合、まず、対象となるデータを一時テーブルに抜き出すとよいでしょう。A4に出力しても余白だらけというコードで可能かと思いますよ。

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

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

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

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

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

お礼

f_a_007 様

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

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

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

補足

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

受注日 氏名 会員番号 商品コード 商品名 数量 価格
2014/04/01 山田花子 12345678 55555 魔法瓶 1 2980
2014/04/02 大島太陽 34567890 55555 魔法瓶 1 2980
2014/05/01 山田花子 12345678 33333 御茶碗 1 1280
2014/05/14 大島太陽 34567890 55555 魔法瓶 2 5960
2014/07/15 山田花子 12345678 22222 洗面器 1 980
2014/08/19 佐藤一郎 56789870 11111 お箸 1 580
2014/09/10 佐藤一郎 56789870 11111 お箸 1 580

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

受注日 氏名 会員番号 商品コード 商品名 数量 価格
2014/04/01 山田花子 12345678 55555 魔法瓶 1 2980
2014/05/01 山田花子 12345678 33333 御茶碗 1 1280
2014/07/15 山田花子 12345678 22222 洗面器 1 980

回答No.2

山田 太郎（@f_a_007）

どうも私が質問内容を理解していませんね。
現状では、添付図のように表示されていますよね。
で、これがダメ！

ということですか？

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

お礼

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

補足

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

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

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

回答No.1

山田 太郎（@f_a_007）

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

補足

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

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