【エクセル】文字列のマッチング検索のVBA

以下前回の質問でやりたいことで
https://oshiete.goo.ne.jp/qa/8949943.html

セルに　キーワードＡ　と　キーワードＢ　がこの順に並んでいるデータを検索で
ひっかかるようにしたいです。

「りんご みかん」という文字列で、りんごとみかんというキーワードが含まれていれば、 この二つのキーワードがどんなに離れた位置にあってもひっかかるようにできる方法はありますでしょうか。

質問者からの補足コメント

• 長文でご説明ありがとうございます。
  とりあえず、元のブック例を作ってみました。
  ⇒こちらにアップロードさせていただきました。　http://yahoo.jp/box/7CiAf4
  
  キーワード集計シートのKW分類の列にどんな分類になるのかを
  きれいに取りまとめたいのです。
  今の段階ではどんなふうにしたら効率のよく分類できるか不明なところです。
  
  ユーザー定義関数を使うという制約はないです。
  cj_moverさんがやりやすいやり方を教えていただけないでしょうか。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/04/09 05:11

• cj_moverさん
  さっそくつかってみました。
  ものすごく使いやすく効率的にできそうです。
  ただ、課題が２つでてきて
  ①会社名が商品の名前と判断してしまったりしてしまう
  （例：バングルーブという会社名　　抽出で　バングルと受け取って”ジュエリー”として扱われる。
  ②二つのキーワードがきた時、○○＋○○とでるようになってほしい。
  
  キーワード例２を作ってみました。こちら⇒　http://yahoo.jp/box/izmV4A
  
  この２つの課題が解決できないでしょうか。

  No.3の回答に寄せられた補足コメントです。 補足日時：2015/04/11 07:05

• バングルについて
  "バングル*"　"*バングル"
  とふたつ作ったのですが、バングルーブでどうしても
  ジュエリーになってしまいました。
  
  [ＫＷ分類]の結果出力範囲のひとつひとつのセルについて、
  マッチした結果のすべてを
  　　"＋"　　全角+
  を区切り文字に指定して
  連結した文字列を返す、
  ということで合っていますか？
  ⇒合っています！
  
  また'スペース'には全く意味はありません。
  ワイルドカードでだけで問題ございません。

  No.4の回答に寄せられた補足コメントです。 補足日時：2015/04/11 19:00

• 無事に稼動できました！！ありがとうございます。
  ただ最初は動いたのですが、急に下記の場所で、
  「実行時エラー 91 オブジェクト変数または with ブロック変数が設定されていません」
  とエラーがでるようになったのですが、これはどういう意味なのでしょうか。
  
  Exit_:
  .Cells(1).Select
  rngCriteria.Clear　←←←ここでエラーが起きます。
  Set Target = Nothing: Set rngResultArea = Nothing: Set rngCriteria = Nothing
  
  If .FilterMode Then .ShowAllData
  .UsedRange '　●＃３解答後に追記
  If blnFilter Then .Rows(1).AutoFilter
  End With

  No.6の回答に寄せられた補足コメントです。 補足日時：2015/04/12 08:18

• シート保護でエラーがでてました。
  cj_moverさんのプログラムで直りました！
  ただ新たに課題がでてきたのが、メーカー名が2文字でキーワードにスペースがないパターン。
  例:"まゆスニーカー"というキーワード
  メーカー名が「まゆ」商品名「スニーカー」
  返ってほしい語が「まゆ＋靴用品」
  設定で、"まゆ*"にしてしておくと、"まゆげ"とか"まゆゆ"とか"まゆみ"とかまで引っかかってしまいます。
  このスペースなしのキーワード対策はもはや無理ですかね？
  
  あと設定してないキーワードがあればそれもわかるようにしたいのですよね。

  No.10の回答に寄せられた補足コメントです。 補足日時：2015/04/12 15:25

• 長文でわかりやすく回答していただきありがとうございます。
  まゆについては、作業で確認するようにします。
  
  しつこいようで本当に恐縮なのですが、最後にSheet1のＡ列[キーワード]に対して
  完全一致を対応することはできるのでしょうか？
  つまりは、「ネクタイ」というキーワードのみのとき、
  "ネクタイ"と設定しておけば、そのキーワードのみと判断させるようなイメージです。

  No.11の回答に寄せられた補足コメントです。 補足日時：2015/04/12 21:55

No.3 回答者： cj_mover 回答日時： 2015/04/10 16:26

Sub ReG8954513()

Dim Target　　　　　As Range　'　検索対象範囲
Dim rngCriteria　　 As Range　'　出力先セル範囲
Dim rngResultArea　 As Range　'　Criteria（フィルター条件）設定範囲
Dim mtxCritTable() As Variant　'　Criteria（先頭はClass名）二次元配列
Dim arrCritYSize() As Long　'　Criteria ブロック毎の各サイズを格納する一次元配列
Dim sTemp As String　'　Criteria 個々の条件を整形する為に一時的に格納する変数
Dim nClassCount　As Long　'　Criteria で指定されているClassの数
Dim nCritMaxSize As Long　'　Criteria ブロックの各サイズの最大値
Dim cntRes　As Long　'　AdvancedFilter で抽出された件数
Dim cntIrr　As Long　'　Criteria 各ブロックの検索条件不正だった場合をカウント
Dim i　 As Long
Dim j　 As Long
Dim blnFilter As Boolean　'　実行前にシートにオートフィルターが適用されていたかどうかフラグ

　　Call AppAsleep(True)
　　On Error GoTo Exit_
　　mtxCritTable = Sheets("Sheet2").Cells.CurrentRegion.Value　'　◆シート名？"Sheet2"？
　　nClassCount = UBound(mtxCritTable)
　　nCritMaxSize = UBound(mtxCritTable, 2)
　　ReDim arrCritYSize(1 To nClassCount)
　　For i = 1 To nClassCount
　　　　For j = 2 To nCritMaxSize
　　　　　　sTemp = mtxCritTable(i, j)
　　　　　　If sTemp = "" Then Exit For
　　　　　　mtxCritTable(i, j) = RevCrit(sTemp)
　　　　Next j
　　　　arrCritYSize(i) = j - 1
　　Next i

With Sheets("Sheet1")　'　◆シート名？"Sheet1"？
　　blnFilter = .AutoFilterMode
　　If blnFilter Then .AutoFilterMode = False

　　With .Cells.CurrentRegion
　　　　Set Target = .Columns(1).Cells
　　　　Set rngResultArea = .Cells(2, 5).Resize(.Rows.Count - 1)　'　◆結果出力先列位置？5？
　　　　Set rngCriteria = .Cells(.Rows.Count + 2, 1).Resize(nCritMaxSize, nClassCount)
　　End With

　　' ' Criteria を Class の数だけ（複数列）一度に纏めて設定
　　rngCriteria.NumberFormat = "@"
　　rngCriteria.Value = Application.Transpose(mtxCritTable)
　　rngCriteria.Rows(1).Value = Target(1).Value　'　Criteria 項目名を設定
　　rngResultArea.ClearContents

　　' ' Criteria 各ブロック毎にループ
　　For i = 1 To nClassCount
　　　　If arrCritYSize(i) > 1 Then
　　　　　　' ' Criteria 各ブロック毎に[フィルター][詳細設定]を実行して抽出
　　　　　　Target.AdvancedFilter _
　　　　　　　　Action:=xlFilterInPlace, _
　　　　　　　　CriteriaRange:=rngCriteria.Columns(i).Resize(arrCritYSize(i)), _
　　　　　　　　Unique:=False

　　　　　　If .FilterMode Then　'　抽出が行われていたならば
　　　　　　　　cntRes = WorksheetFunction.Subtotal(3, Target) - 1　'　抽出された件数
　　　　　　　　If cntRes Then　'　抽出された件数が１つ以上であれば、
　　　　　　　　　　' ' 出力先セル範囲 の 抽出された可視範囲 の 空白セル に クラス名を出力
　　　　　　　　　　rngResultArea.SpecialCells(xlCellTypeVisible).Select
　　　　　　　　　　On Error Resume Next
　　　　　　　　　　Selection.SpecialCells(xlCellTypeBlanks).Value = mtxCritTable(i, 1)
　　　　　　　　　　On Error GoTo Exit_
　　　　　　　　End If
　　　　　　　　Debug.Print mtxCritTable(i, 1), cntRes
　　　　　　Else
　　　　　　　　cntIrr = cntIrr + 1
　　　　　　　　Debug.Print mtxCritTable(i, 1), "検索条件不正"
　　　　　　End If

　　　　End If
　　Next i
　　Erase mtxCritTable(), arrCritYSize()

Exit_:
　　.Cells(1).Select
　　rngCriteria.Clear
　　Set Target = Nothing:　　Set rngResultArea = Nothing:　　Set rngCriteria = Nothing

　　If .FilterMode Then .ShowAllData
　　If blnFilter Then .Rows(1).AutoFilter
End With

　　Call AppAsleep(False)
　　If Err Then
　　　　MsgBox "実行時エラー：" & Err & vbLf & Err.Description, vbExclamation, "実行時エラー"
　　ElseIf cntIrr Then
　　　　MsgBox "不正な検索条件が " & cntIrr & " 件 ありました。", vbExclamation
　　Else
　　　　MsgBox "正常に処理が終了しました。", vbInformation
　　End If
End Sub

Private Function RevCrit(ByVal Source As String) As String
　　If InStr(1, Source, " ", vbTextCompare) Then
　　　　Source = Replace(Trim$(Source), " ", "*", , , vbTextCompare)
　　End If
　　If InStr(Source, "＊") Then Source = Replace(Source, "＊", "*")
　　If (InStr(Source, "*") <> 1) And (InStrRev(Source, "*") <> Len(Source)) Then Source = "*" & Source & "*"
　　RevCrit = "=" & Source
End Function

Private Sub AppAsleep(ByVal Asleep As Boolean)
　　With Application
　　　　If Asleep Then
　　　　　　.ScreenUpdating = False
　　　　　　.Calculation = xlCalculationManual
　　　　　　.EnableEvents = False
　　　　Else
　　　　　　.Calculation = xlCalculationAutomatic
　　　　　　.EnableEvents = True
　　　　　　.ScreenUpdating = True
　　　　End If
　　End With
End Sub

Sub EraseResult()
　　With Sheets("Sheet1").Cells(1, 1).CurrentRegion　'　◆シート名？"Sheet1"？
　　　　.Columns(5).Resize(.Rows.Count - 1).Offset(1).ClearContents　'　◆結果出力先列位置？5？
　　End With
End Sub

No.2 回答者： cj_mover 回答日時： 2015/04/10 16:24

こんにちは。

作成したマクロは、次回の投稿に掲げます。

いくつか要求仕様を確認しないとならない点もありますが、
今のところ、仕様というより設計的に定まっていない点があるのだと思います。
仮に暫定的であったとしても、実際に動作した結果を確かめながら、
求めるべき仕様に初めて気が付くということもあるでしょうから、
開発を段階的に進めていくことでしか、最終的な仕様には辿り着けないのかも知れません。
ひとつの叩き台として、という意味付けを理解した上で、
こちらの解釈を盛り込んだ上で選択した、ひとつの形、としての暫定仕様
を基に、ひとつの正しい結果を得られるようなマクロを書きました。
最終的な仕様は私が決めるものではありませんので、
この後、どう進めて行くかは、mackojiさんに委ねます。
確定していないであろう仕様上の確認事項を、下段に挙げておきますので、、、。

マクロにした理由は、ユーザー定義関数よりも圧倒的に処理が速いこと、
使用できるメソッドが自由に選べ、有利な設計を実践できること、などです。

マクロにしたことに伴って、ブックの保存形式をマクロ有効ブックに換える必要があります。
[キーワード例.xlsx]が開いている状態から、
[名前を付けて保存]→[ファイルの種類]に[Excel マクロ有効ブック（*xlsm）]を選択指定、
[ファイル名]が[キーワード例.xlsm]に自動的に変更されるので、
そのまま[保存]します。
マクロ有効ブックとなった[キーワード例.xlsm]にて、
標準モジュールを追加して、次の投稿にあるスクリプト全文をコピペします。
マクロ名'ReG8954513'が実際に使用するマクロですが、このマクロ名は適宜変更してお使い下さい。
マクロの実行は、Excel画面から、[Alt]+{F8]キーでマクロ名を選択して実行するとか、
マクロ名'ReG8954513'をボタン等に登録しておいて実行することになります。
一旦上書き保存をしておいてから、マクロを実行して、
動作確認、結果を検証するようにしてください。
因みに、マクロ'EraseResult'は、[ＫＷ分類]項目の結果出力範囲を消去するものです。
検証をやり直す時に簡便になるよう添えておきます、

■[Sub ReG8954513()]の処理内容について。
純粋なプログラムとして書くより、Excel一般機能を活用したＶＢＡマクロとした方が
効率的な処理が可能になるので、
Excel一般機能の[フィルター/詳細設定]（ＶＢＡではAdvancedFilter）を使用しています。
一応[フィルター/詳細設定]について、[検索条件範囲]の指定方法などは、お浚いしておいてください。
----------
キーワード
=会社A*
----------
キーワード
=*あかちゃん*
----------
キーワード
=*ゴルフ*
=*ゴルフ*ボストン*
=*golf*
----------
等の様に、文字列をセル範囲に設定しておいて、
これらを[フィルター/詳細設定]の[検索条件範囲]として用いています。
[フィルター/詳細設定]の[リスト範囲]には、Sheet1のＡ列を指定します。

■[キーワード例.xlsx]Sheet2にある、検索条件テーブルの内容について。
1)
"*あかちゃん*"には両側に"*"がついているので、これは部分一致を意図したものだと解ります。
"会社A*"には右端に"*"がついているので、これは前方一致を意図したものだと解ります。
"ゴルフ"以下のキーには、"*"がついていないのですが、
これが完全一致を意図したものだとは思えません。
完全一致を求めるような処理ではないだろうという予想を基に、
両端のどちらにも"*"がついていないキーは、すべて部分一致として扱うように書きました。
つまり、"*あかちゃん*"と書いても"あかちゃん"と書いても同じ結果になります。
"会社A*"は前方一致を、例えば"*シャツ"のように書けば、後方一致を実現します。
完全一致は一切扱わないようにしています。

2)
"会社A　シャツ"の意図は、"=*会社A*シャツ*"というパターンの省略と判断しました。
"*会社A*"が部分一致、且、"*会社A*"より後方で"*シャツ*"が部分一致、という条件になります。
"=会社A*シャツ"のように、"会社A*"前方一致、且、"*シャツ"後方一致、
を意図したものではない、と判断しました。

3)
少し混乱してしまいましたが、
　　"スポーツ" ｜ "ゴルフ"　"ゴルフ ボストン"　"golf"
については、
"*ゴルフ*"部分一致の抽出結果の中に、
"*ゴルフ*ボストン*"部分一致の抽出結果も必ず含まれますから、
"ゴルフ ボストン"は、無くてもいいように思うのですが、
何か特別な意図があったのでしょうか？
"ゴルフ"の意図は完全一致なのかしら？とも考えましたが、
[リスト範囲]に完全一致するセルが無いことから、"ゴルフ ボストン"の方が書き間違い、
と判断しました。
　　"スポーツ" ｜ "ゴルフ"　"golf"
と書いても同じ結果が返ります。

4)
Sheet2のＡ列の内容は、[ＫＷ分類]項目に結果として返す[クラス名or分類名]
に相当します。
　　"ベビー" ｜ "*あかちゃん*"
というテーブルだと、
[クラス名or分類名]"ベビー"に該当するキーは、"=*あかちゃん*"だけです。
"ベビー"というキーにもヒットさせたいならば、
　　"ベビー" ｜ "ベビー"　"*あかちゃん*"
または
　　"ベビー" ｜ "ベビー"　"あかちゃん"
のように指定することになります。

5)
[ＫＷ分類]項目に結果として返す[クラス名or分類名]については、
先に一致したものを優先させ、
その後に一致したものは反映（上書き）されないように書いています。
　　"会社A" ｜ "会社A*"
　　"会社A+シャツ" ｜ "会社A　シャツ"
のように詳細度の高い検索条件を下側に書いてある場合は、
"会社A+シャツ"の一致が反映されずに、"会社A"の一致だけが結果として返ります。
詳細度の高い検索条件を上に書いて
　　"会社A+シャツ" ｜ "会社A　シャツ"
　　"会社A" ｜ 会社A*"
のような順に書いて置けば、
"=*会社A*シャツ*"の検索条件が優先されて、結果は"会社A+シャツ"
それ以外の"=*会社A*"の検索条件に一致するものは、結果が"会社A"
のようになります。

■[ＫＷ分類]項目に返す結果内容について。
前項5)に関連した話ですが、
例えば、Sheet1のA139
"会社A ゴルフバック"
は、
　　"会社A" ｜ 会社A*"
　　"スポーツ" ｜ "ゴルフ"　"golf"
の順に書かれていれば、"会社A"
　　"スポーツ" ｜ "ゴルフ"　"golf"
　　"会社A" ｜ 会社A*"
の順に書かれていれば、"スポーツ"
という風に上に書かれた検索条件を優先した結果を返すことになります。
仮に、検索条件として
　　"バッグ" ｜ "バッグ"　"bag"
を追加する、ということもあるのかも知れないですね。
このように複数の条件にマッチするものをどうするか、
動作確認と検証をする中で、設計を方向付けていくよううにして下さい。
例えば、Sheet1のA139
"会社A ゴルフバック"
に対して、
　　"会社A" ｜ 会社A*"
　　"スポーツ" ｜ "ゴルフ"　"golf"
　　"バッグ" ｜ "バッグ"　"bag"
という検索条件で、どのような結果を返すかについては、ざっと３通り考えられます。
a.私が提示した暫定仕様のように優先度を決めて優先度最上位のものだけ結果を返す。
b.すべてのマッチした結果を列方向に拡張した複数セル範囲E139:G139に返す。
　　E139　　　　F139　　　　G139
　　"会社A"　"スポーツ"　"バッグ"
c.すべてのマッチした結果をひとつのセルE139に連結して返す。
　例えば、カンマを区切り文字として、"会社A,スポーツ,バッグ"　をセルE139に返す。
これら３通りそれぞれに、使い勝手が変わって来ますから、
ここで得られる結果を使って、
どのような集計/分析をしていきたいのか、俯瞰的/長期的なビジョンを持って、
最終仕様を決めていくことのなるかと思われます。
a.の場合は、検索条件テーブルに精度/確度がが求められます。
すべての編集者に管理を徹底することができるかどうかがネックになります。
b.の場合は、[ＫＷ分類]項目をより細分化することになりますので、
詳細な分析には向いていますが、ひとつの[ＫＷ分類]によるフィルタリングが
出来なくなります。
c.の場合は閲覧用のレポートとしては、有効な方法かも知れませんが、
分析に用いるとなると、技術的な難度が高くなります。

///

そちらで、確認・検証した上で決めていく必要があること、の内、
重要度の高いものを、以上のように整理しました。
こちらでも検証には時間を掛けて注意を払ったつもりですが、
いずれにしても、決めるのはmackojiさんです。
仕様や設計に関する新たな補足があれば、出来るだけお応えするつもりです。

長文になってしまい、すみません。

No.1 回答者： cj_mover 回答日時： 2015/04/06 10:04

こんにちは。

補足が付くかな？と待っていたのですが、、、
今のままでは情報不足で答えられないです。
前回の質問では、必要な説明がすべてリンク先のページに書かれていましたから、
こちらでは５分でサンプルシートを作成して、
次の１０分で最初のプロットまで書けたということもあって、
迷わず回答できたのですが、今回は未だにサンプルを作ることも出来ていません。
シート上での具体的な位置関係とセル値の具体例という形で示すことは可能でしょうか？
「戻り値にするクラス名」
「クラスに対応させるキワード群」
「マッチィングさせる対象の文字列」
「戻り値を返すセル範囲」（関数を設定するセル）
少なくとも、これらの状況、【４つのパラメータ】が解っていたので着手できたのです。

> セルに　キーワードＡ　と　キーワードＢ　がこの順に並んでいるデータを検索で
> ひっかかるようにしたいです。
「ひとつのセルに、"キーワードＡ"... 間に適当な文字列... "キーワードＢ"　の順に並んでいる」
という意味なのか、
「同じ行の複数の列位置にあるセルにキーワードが並んでいて」
例えば
Ｂ２="キーワードＡ"、Ｂ５＝"キーワードＢ"、Ｂ３：Ｂ４,Ｂ６以降に適当なキーワード
という並びであって、
「列位置の順番に並んでいる」
という意味なのか、判読できていません。
上記【４つのパラメータ】の内のどれのことでしょうか？

> 「りんご みかん」という文字列で、りんごとみかんというキーワードが含まれていれば、 この二つ> のキーワードがどんなに離れた位置にあってもひっかかるようにできる方法はありますでしょうか。
「りんご みかん」というのは、上記【４つのパラメータ】の内のどれのことでしょうか？

> キーワードＡ　と　キーワードＢ　がこの順に並んでいるデータを検索で ひっかかるようにしたい
> りんごとみかんというキーワードが含まれていれば、 この二つ のキーワードがどんなに離れた位置にあってもひっかかるようにできる
「二つ のキーワード」について、
「順に並んでいる」のと「含まれている」のとでは、まったく違う処理になりますが、
どちらなのでしょう？

また、前回は、ユーザー定義関数に関する質問でしたが、
今回は、ユーザー定義関数である必要があるのかどうかについても明確にしてください。
「関数＝ユーザー定義関数」の手法と「メソッド＝マクロ」の手法とでは、
別世界の技術ですので、内容は大きく変わります。

具体例として、「どこのセル」に「どんな値」があり、「どんな結果」が返ればいいのか、
要求を整理してから補足してみて下さい。
こちらが書き始められる十分な内容であれば、優先的に着手します。