ExcelでWeb検索のような検索を実現したい

質問

「Office TANAKA」のホームページを参考にして、Excelをデータベース的に使用したいと考えています。
あるセルに検索条件を入力して、条件に合うセルを検索したいのですが、検索条件はWeb検索のように、以下の(1)～(3)ように入力したいと思っています。
(1)検索ワードをスペースで区切るとAND検索
(2)検索ワードをORで区切るとOR検索
(3)検索ワードの前に、－を付けるとNOT検索

【例】 あ　い　（う　OR　え）　－お
※上記の例は、「あ」を含み、かつ、「い」を含み、かつ、「う」または「え」を含み、かつ、「お」を含まないセルを検索する条件です。

仕事でAccessのないPCで、Excel VBAを駆使してデータベース的に使用したいと思っています。
どうか、ご協助ください。よろしくお願い致します。

回答No.7

mitarashi

#6です。調子に乗っています。すみません。
正規表現版を作成してみました。
(アクセス Or Access）には対応しました。
アクセス Or Access　に対応していないのは仕様です（複数のOrも考えると、スッキリした対策が浮かばないので．．．）
UserFormから呼ぶところは省略しております。
小難しいSQLを作成しないで、どうせコードで処理するので、AND条件だけのSQLを複数生成して、順次抽出する様にすれば、別の解があるのかなと感じております。

Function makeSQL(myTableName As String, myFieldname As String, matchWord As String) As String

Dim orStr As String, andStr As String
Dim andConditions As Variant, orConditions As Variant
Dim mySQL As String, whereStr As String
Dim i As Long
Dim orFlag As Boolean
Dim regEx As Variant, Matches As Variant
Dim submatchword As String, targetString As String

targetString = treat(matchWord)

Set regEx = CreateObject("VBScript.RegExp")
regEx.MultiLine = False
regEx.Pattern = "\((.+?)\)"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(targetString)
'(.+)が2個以上ヒットしていればエラーを戻す
If Matches.Count >= 2 Then
MsgBox "Or条件は一個のみ対応です"
makeSQL = "Error"
Exit Function
End If
If Matches.Count > 0 Then
orFlag = True
orStr = Matches(0).submatches.Item(0)
andStr = Trim(regEx.Replace(targetString, ""))
regEx.Pattern = "\s{2,}"
Set Matches = regEx.Execute(andStr)
If Matches.Count > 0 Then andStr = regEx.Replace(andStr, " ")
Else
andStr = targetString
End If
Set Matches = Nothing
Set regEx = Nothing

If andStr <> "" Then
andConditions = Split(andStr, " ")
For i = 0 To UBound(andConditions)
If Left(andConditions(i), 1) = "-" Then
andConditions(i) = "(myFieldName Not Like (""%" & Mid(andConditions(i), 2, Len(andConditions(i)) - 1) & "%""))"
Else
andConditions(i) = "(myFieldName Like (""%" & andConditions(i) & "%""))"
End If
Next i
whereStr = Join(andConditions, " And ")
End If

If orFlag Then
orConditions = Split(orStr, " OR ")
If andStr = "" Then
For i = 0 To UBound(orConditions)
orConditions(i) = "(" & "(myFieldName Like (""%" & orConditions(i) & "%"")))"
Next i
Else
For i = 0 To UBound(orConditions)
orConditions(i) = "(" & whereStr & " And " & "(myFieldName Like (""%" & orConditions(i) & "%"")))"
Next i
End If
End If

If orFlag Then
mySQL = "Select * From myTableName Where " & Join(orConditions, " Or ") & ";"
Else
mySQL = "Select * From myTableName Where " & whereStr & ";"
End If
mySQL = Replace(mySQL, "myTableName", myTableName)
mySQL = Replace(mySQL, "myFieldName", myFieldname)
makeSQL = mySQL
End Function

Function treat(sourceWord) As String
Dim buf As String

buf = UCase(sourceWord)
buf = Replace(buf, "（", "(")
buf = Replace(buf, "）", ")")
buf = Replace(buf, "ＯＲ", "OR")
buf = Replace(buf, "　", " ")
buf = Replace(buf, " －", " -")
buf = Replace(buf, " ー", " -")
treat = buf
End Function

お礼

ありがとうございます。ここまで丁寧に回答して頂きまして、感謝、感激で、涙ボロボロです。