#623 スペース区切りの複数ワードからWHERE句を組み立てるサンプル VBA

Accessのクエリなどでは通常フィールドごとに抽出条件(WHERE句)を設定しますが、画面のインタフェースや機能として、ひとつのテキストボックスに入力された任意の値を条件に検索したい場合があると思います。

さらにその応用として、そこに単一の検索条件のキーワードを入力するのではなく、スペースで区切ることによって複数キーワードによる検索を行いたい場合もあると思います。

たとえばテキストボックスに「東京△神奈川△千葉」(△はスペース)と入力したとき、「住所に”東京”または”神奈川”または”千葉”」を含むレコードを検索するような場合です。

あるいはさらに複雑に、「東京△神奈川△千葉」と入力したとき、『「発送元住所に”東京”または”神奈川”または”千葉”」を含む、あるいは、「送付先住所に”東京”または”神奈川”または”千葉”」を含む』といったように、全文検索的に複数のフィールドに対して同じキーワードを展開したいこともあると思います。これをVBAのコード上でSQL文を組み立てるのはかなりやっかいで長い記述になってしまいます。


そこで、(ある程度ですが)汎用的に使えそうなスペース区切りの複数ワードからWHERE句を組み立てるプロシージャの一例を紹介します。

なおここでは、検索対象となるフィールド名までは引数で指定できるようになっていません。このプロシージャ内への組み込みで固定となっています。また、ANDやORの条件はケースバイケースかもしれませんが、ここではすべてORで固定(ネットの検索エンジンではANDが一般的ですが)となっています。これらの部分は適宜アレンジしてみてください。


【フォームのデザインビュー】


【VBAのコード:フォームモジュール】

Option Compare Database
Option Explicit

Private Sub cmd検索_Click()

  With Me!frm得意先検索_sub.Form
    If Not IsNull(Me!検索キーワード) Then
      'キーワードでWHERE句を組み立ててフィルタ実行
      .Filter = BuildWhere(Me!検索キーワード)
      .FilterOn = True
    Else
      'フィルタを解除
      .Filter = ""
      .FilterOn = False
    End If
  End With

End Sub


Private Function BuildWhere(ByVal strKeyWord As String) As String

  Dim avarWords As Variant
  Dim strCurWord As String
  Dim strWhere As String
  Dim iintLoop As Integer

  '全角スペースの置換
  strKeyWord = Replace(Trim$(strKeyWord), " ", " ")
  avarWords = Split(strKeyWord, " ", , vbTextCompare)

  '各キーワードのWHERE句の組み立て
  For iintLoop = 0 To UBound(avarWords)
    If Len(Trim$(avarWords(iintLoop))) > 0 Then
      strCurWord = " LIKE ""*" & Trim$(avarWords(iintLoop)) & "*"""
      strWhere = strWhere & IIf(Len(strWhere) > 0, " OR ", "") & "(" & _
                  "会社名" & strCurWord & " OR " & _
                  "姓" & strCurWord & " OR " & _
                  "名" & strCurWord & " OR " & _
                  "部署" & strCurWord & " OR " & _
                  "市区町村" & strCurWord & _
                  ")"
    End If
  Next iintLoop

  '返り値を設定
  BuildWhere = strWhere

End Function


実行例:


| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved