Accessフォームでの複数条件検索

検索用テキストが４つとコンボボックスが１つあり、検索ボタンというコマンドボタンを押すと
該当するレコードを表示させるフォームを作りました。
以下がそのVBAです。


Private sub 検索ボタン_click()

Dim strfilter As String, strexp As String, aryope As Variant
If Not IsNull (me.一) Then
strfilter = "And 出版社 Like '*" & Me.一 & "*'"
End If

If Not IsNull (me.コンボ62) Then
strfilter = "And 種類 Like '*" & Me.コンボ62 & "*'"
End If

If Not IsNull (me.三) Then
strfilter = "And 番号 Like '*" & Me.三 & "*'"
End If

If Not IsNull (me.四) Then
strfilter = "And 発刊日 = # " & Format (me.四. "yyyy-mm-dd") & "#"
End If

If Not IsNull (me.一) Then
strfilter = strfilter & " AND " & BuildCritera ( "タイトル", dbText, "*" Replace ( me.五, "", "*AND*") & "*")
End If

改正したいことは
　　1.　検索用テキストボックスに入力された値全てを満たすレコードを表示したい（現在は例えば
　　　　出版社、タイトル、番号の3つを入力するとそれぞれの項目にヒットする物がすべて検出さ
　　　　れる)
　　2.　テキストボックス[三]の番号は完全一致で抽出したい（２６を抽出したいのに１２６や２６７３
　　　　等も抽出されてしまう)
　　3.　テキストボックス[四]の発刊日は西暦表示から和暦で入力して検索したい
　　　　（テキストボックス[四]をコンボボックスに変え、西暦・和暦両方表示にし、[四Ａ]を追加して
　　　　月日という名前にしてこれら年月日をくっつけて完全一致で検索する方法を考えましたが
　　　　記述がわかりません）
　　5．タイトルがＷｅｂ検索の様に複数曖昧検索ができない

　　　　中途半端な検索で抽出してる状態です。
　　　　どなたか手直しいただけますでしょうか？　

No.2 回答者： 30246kiku 回答日時： 2012/10/11 04:21

＃１です

> 今日職場で上記のＶＢＡ貼り付けて見ましたが、検索ボタンをクリックしても何の反応もしなかったり固まるだけでした。

これだけでは、そうですか・・・としか、言いようがありません。
情報が全くありません。

sFilter を作っているだけなので、それ以降どのような記述されたのか見えません。
提示した範囲で固まる部分は無いと思いますが・・・

私には無理だと思います。
私から最後になります（補足等あれば別ですが）

フォームのデザインで、「一」とか「コンボ62」等の名前は変更されたと思いますが
以下の操作をしてどうなりますか

・　sFilter = ""　の行にブレイクポイントを設定
・検索ボタンのクリックで、上記箇所で止まりますか
・止まったのなら、ステップ実行して sFilter の内容はどのように変化していきますか


ご質問された時の VBA 記述部分は、どのようになっていたのでしょう。
コピー＆貼り付けされたものではないですよね。
（実際に記述され、動いていた/動かそうとしていたものではなさそうですが）

Private sub 検索ボタン_click()　普通にイベントプロシージャで作っていたら
Private Sub 検索ボタン_Click() になっていると思われ、
Format (　や Replace (　は、Format(　や Replace(　になっていたと思われますが。
BuildCritera　は自作されたものだったでしょうか。

そのようなものを何故提示されたのかが疑問にありますが
私が提示したのは、標準モジュールに実際に記述してみて、その結果を貼り付けています。
フォームは作っていないので未検証です。（西暦・和暦部分だけ動かしてみたけど）
連続スペースをスペース１個にする部分は、以下で検証済みです

Private Sub test33()
　　Dim sFilter As String, sS As String
　　Dim iL(1) As Long
　　Const sAndOr As String = " AND "

　　sFilter = ""
　　sS = "A　　　　　　　　　　 B　　　　 C D"
　　iL(0) = 0
　　iL(1) = Len(sS)
　　While (iL(0) <> iL(1))
　　　　sS = Replace(sS, " ", " ") ' 2個スペースを1個に
　　　　iL(0) = iL(1)
　　　　iL(1) = Len(sS)
　　Wend
　　sS = "*" & Replace(sS, " ", "* AND *") & "*"
　　sFilter = sFilter & sAndOr & BuildCriteria("タイトル", dbText, sS)
　　If (Len(sFilter) > 0) Then sFilter = Mid(sFilter, Len(sAndOr) + 1)
　　MsgBox sFilter
End Sub


注意が一つ

>　sS = Replace(sS, " ", " ") ' 2個スペースを1個に（QA表示上わからないかも）

の記述がありますが、
教えてgoo、 OKWave　とも、コピー＆貼り付けではおかしくなるようです。
両方とも、スペースが１つになってますね。
（お礼・補足の通知メールが来ましたが、その中の記述はまともでした）

上記半角スペース部分を ▲ に置換えて記述すると以下の様になります。

　sS = Replace(sS, "▲▲", "▲")

ここがコピー＆貼り付け後の状態のままでも、動作としてはおかしくなることはありません。
スペースが連続した時には　タイトル Like "**" が増えていくだけです。

なお、現状では
教えてgoo　からのコピー＆貼り付けでは、行頭に不要なスペースが付加されるようです。
コピー＆貼り付けに関しては、OKWave の方がまだましかも・・・・

補足）

>　　sS = "*" & Replace(sS, " ", "* AND *") & "*"

上記部分は 　　sS = "*" & Replace(sS, " ", "*" & sAndOr & "*") & "*"
の方が良かったかも・・・


以上

情報が無い状況ではお手上げです。
（提示された部分の手直しは完了していると思っています）

No.1 回答者： 30246kiku 回答日時： 2012/10/09 09:44

以下、私なりに気付いた点

・コントロール名はわかりやすく
　例）
　「一」→「txt出版社」
　「コンボ62」→「cmb種類」

・一致は Like ではなく =

・何を記述しているのか理解する
　例１）
　strfilter = "And 種類 Like '*" & Me.コンボ62 & "*'"
　↓？
　strfilter = strfilter & " And 種類 Like '*" & Me.コンボ62 & "*'"

　例２）
　"*" Replace ( me.五, "", "*AND*") & "*"
　↓
　"*" & Replace( me.五, " ", "* AND *") & "*"

　「A　B　C」（A空白B空白C）という文字列があったら
　「*A* AND *B* AND *C*」にするんじゃ・・・
　「A　 B　C」（A空白空白B空白C）という文字列があったら
　「*A* AND ** AND *B* AND *C*」になるけど・・・

・スペースの扱い方に気を付ける
　例）
　"And 発刊日 = # "　→　" And 発刊日 = #"
　Format (me.四. 　→　Format(me.四,

・実際にある関数を使用する
　例）
　BuildCritera　→　BuildCriteria


上記を踏まえ、全体的に書き換えて見ると以下に（変数名は適宜変更してください）

Dim sFilter As String, sS As String
Dim iL(1) As Long
Const sAndOr As String = " AND "

sFilter = ""
If Not IsNull(Me.txt出版社) Then
　　sFilter = sFilter & sAndOr & "出版社 Like '*" & Me.txt出版社 & "*'"
End If
If Not IsNull(Me.cmb種類) Then
　　sFilter = sFilter & sAndOr & "種類 Like '*" & Me.cmb種類 & "*'"
End If
If Not IsNull(Me.txt番号) Then
　　sFilter = sFilter & sAndOr & "番号 = '" & Me.txt番号 & "'"
'　　sFilter = sFilter & sAndOr & "番号 = " & Me.txt番号 ' 番号が数値型ならこっち
End If
If Not IsNull(Me.txt発刊日) Then ' 発刊日が、日付/時刻型の場合
　　sFilter = sFilter & sAndOr & "発刊日 = #" & Format(Me.txt発刊日, "yyyy/mm/dd") & "#"
End If
If Not IsNull(Me.txtタイトル) Then
　　sS = Me.txtタイトル
　　iL(0) = 0
　　iL(1) = Len(sS)
　　While (iL(0) <> iL(1))
　　　　sS = Replace(sS, " ", " ") ' 2個スペースを1個に（QA表示上わからないかも）
　　　　iL(0) = iL(1)
　　　　iL(1) = Len(sS)
　　Wend
　　sS = "*" & Replace(sS, " ", "* AND *") & "*"
　　sFilter = sFilter & sAndOr & BuildCriteria("タイトル", dbText, sS)
End If
If (Len(sFilter) > 0) Then sFilter = Mid(sFilter, Len(sAndOr) + 1)

上記は環境が無いので、未検証

発刊日の検索について、表示は西暦、入力は和暦・・・　
やったことないので間違っていると思いますが、そのテキストボックス「txt発刊日」の
書式を「日付（S)」に、
定型入力を「>L99\年99\月99\日;0;_」
とすると、入力時は「T S H」を付けた入力になるようです。

操作上良いのか悪いのかわかりませんが、「txt発刊日」の「フォーカス取得時」を

Private Sub txt発刊日_Enter()
　　Me.txt発刊日 = Null
End Sub

とすると、必ず和暦での入力になるようです。

この回答への補足

30246kikuさん、こんばんわ。
今日職場で上記のＶＢＡ貼り付けて見ましたが、検索ボタンをクリックしても何の反応もしなかったり固まるだけでした。

補足日時：2012/10/10 21:34

この回答へのお礼

回答ありがとうございます。
早速明日職場に行ってやってみます。
必ず結果報告させて頂きますね。

お礼日時：2012/10/09 17:38