こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

【Access VBA】過去時点での在庫検索

現在、蔵書管理表をAccessで作成しています。

書籍は購入後、古くなると廃棄するようになっています。

現時点での蔵書だけではなく、過去日付を検索フォームに入力すると、
その過去時点の蔵書もAccessで表示できるようにしたいと思っています。

データが入力されているフォーム「蔵書一覧」のフィールドは
「(1)書籍名 (2)購入日 (3)廃棄日」の3つがあり、廃棄が終了すると
「(3)廃棄日」フィールドに廃棄した日付を入力します。
未廃棄のものは、「(3)廃棄日」フィールドには日付を入力せず空欄のままです。

そこで、ある過去時点での蔵書を抽出するために、VBAを以下のように記述したところ、
「(3)廃棄日」が入力されているレコードは抽出できるのですが、
未廃棄のレコード(「(3)廃棄日」に日付が入っていないレコード)がうまく抽出できません。

Private Sub 検索ボタン_Click()

Dim filter1 As String
DoCmd.OpenForm "蔵書一覧", acNormal

filter1 = "廃棄日 >= # " & Me!検索日付 & "#"
Forms!蔵書一覧!.Filter = filter1
Forms!蔵書一覧!.FilterOn = True
End Sub

未廃棄の蔵書も抽出するにはどのようにコードを記述すればよいでしょうか。
どなたかお教えいただけませんでしょうか、よろしくお願いいたします。

投稿日時 - 2018-06-17 10:45:42

QNo.9509179

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.7

【補足】IsNull()を利用するかしないか?

これは、好みと趣味の問題です。

Len([fieldname] & "")

で長さ=0 なら”偽"、長さ>0なら”真”。で、空値かどうかを判定できます。が、Access には IsNull 関数が用意されています。添付図のように、どちらを利用しても同じ結果が得られます。まあ、Empty値のチェックではISNull()が通用しないので、私は、Len(XXX & "")で一貫していますが、全く、これは好みと趣味の問題です。

投稿日時 - 2018-06-17 19:03:16

お礼

f_a_007さん、ご丁寧に回答いただき誠にありがとうございました。
無事抽出することができました。
大変勉強になりました。

投稿日時 - 2018-06-17 20:56:36

ANo.6

他の方の回答を見て、テストデータの不足に気が付きました。で、4件で再テスト。

【全ての蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 ORDER BY 購入日, ID",,Chr(13) )

1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;ワンワン物語;ハスキー社;原一郎;2002/01/01;
3;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;2002/12/31
4;Siberian Husky WON WON;白水社;新倉万蔵;2003/01/01;

【指定日以前に購入して廃棄していない蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/30# AND Not Len(廃棄日 & """") ORDER BY 購入日, ID",,Chr(13))

2;ワンワン物語;ハスキー社;原一郎;2002/01/01;

【指定日以前に購入して、指定日までに廃棄していない蔵書】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/30# AND (廃棄日>#2002/12/30# Or Not Len(廃棄日 & """")) ORDER BY 購入日, ID",,Chr(13))

1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;ワンワン物語;ハスキー社;原一郎;2002/01/01;
3;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;2002/12/31

が正解!?あっているかどうかは、質問者もよく確認されてください。赤で良いと思うのですが・・・

投稿日時 - 2018-06-17 18:35:48

ANo.5

失礼しました。

>ある過去時点での蔵書を抽出する

ということなので、購入日も考慮して、


filter1 = "([購入日] <= # " & Me!検索日付 & "#) And ([廃棄日] >= # " & Me!検索日付 & "# Or [廃棄日] Is Null)"


とします。

投稿日時 - 2018-06-17 14:34:10

お礼

piroin654さんありがとうございました。
無事目的通り抽出することができました。
大変勉強になりました。

投稿日時 - 2018-06-17 20:55:15

ANo.4

>書籍は購入後、古くなると廃棄するようになっています。

>現時点での蔵書だけではなく、過去日付を検索フォームに入力すると、
>その過去時点の蔵書もAccessで表示できるようにしたいと思っています。


という条件で、
>書籍は購入後、古くなると廃棄するようになっています。
が必ず実行されているということであれば、

複数条件でのフィルタのかけ方で、質問の場合は、


filter1 = "[廃棄日] >= # " & Me!検索日付 & "# Or [廃棄日] Is Null"


とします。

投稿日時 - 2018-06-17 13:19:59

ANo.3

【おまけ】いちいち、SQL文やFilterをフォームを開いて確認は手間。

その手間を省くには、[イミディエイトウインドウ]でチョコチョコとテストされたらいいです。その為には、添付図のようなDBSelect()関数を標準モジュールに追加するだけ。

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

ADODBを参照するように設定する必要があるかもですが、そこら辺の要領は検索されて下さい。なお、3番目の引数に Chr(13) をしてしないと、レコード単位で改行しません。

投稿日時 - 2018-06-17 11:54:04

ANo.2

クエリもオープン文も、もちろん3番目のSQL文を書きます。例示は、ちょいとコピペミスしております。が、意味は通じると思います。

投稿日時 - 2018-06-17 11:39:59

お礼

f_a_007 さんありがとうございます。
ご回答いただいた内容で試してみます。

投稿日時 - 2018-06-17 13:08:06

ANo.1

1、filtr 機能を使うケースではないと思います。
2、テーブル構造を明示して質問されたが正答を得られるかと思います。

【全ての蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧",,chr(13))
1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;
3;Siberian Husky WON WON;白水社;新倉万蔵;2003/01/01;

【2002/12/31 以前の蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日<=#2002/12/31#",,chr(13))
1;軽井沢のボーイ;牧野出版;海老原靖芳;2001/01/01;2010/12/31
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;

【2002/12/31時点の蔵書を抽出するSQL文】

? DBSelect("SELECT * FROM 蔵書一覧 WHERE 購入日=<=#2002/12/31# AND NOT LEN(廃棄日 & """")",,chr(13))
2;盲導犬クールの一生;文芸春秋;石黒健吾;2002/01/01;

質問者の書いたSQL文は、上の3つのどれにも該当しません。添付図のように2010/12/31に廃棄した「軽井沢のボーイ」がヒットするだけです。

ということで、書くべき WHERE節(=フィルタの指定文)はお分かりいただけたとおもいます。が、質問者は、

1、フォームをオープンする。
2、フィルタをオンにする。

という手順で[蔵書一覧]を絞り込んでいます。と、いうことは、フォームは、一旦、全てのレコードを読み込んでいるってことです。これは、無駄。

SELECT *
FROM 蔵書一覧
WHERE 購入日<=[検索する日付を入力してください];

というSQL文を用意する。あるいは、[検索日]と[検索コマンドボタン]のあるフォームを用意して

Private Sub コマンド検索_Click()
  Dim stLinkCriteria As String

  stLinkCriteria = "[購入日]<=" & "#" & Me![検索日] & "#"
  DoCmd.OpenForm stDocName, , , stLinkCriteria
End Sub

とやるのが一般的ですね。

投稿日時 - 2018-06-17 11:36:20

あなたにオススメの質問