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

Question

以下前回の質問でやりたいことで
https://oshiete.goo.ne.jp/qa/8949943.html

セルに　キーワードＡ　と　キーワードＢ　がこの順に並んでいるデータを検索で
ひっかかるようにしたいです。

「りんご みかん」という文字列で、りんごとみかんというキーワードが含まれていれば、 この二つのキーワードがどんなに離れた位置にあってもひっかかるようにできる方法はありますでしょうか。

cj_mover · Accepted Answer

＃４補足コメント拝見しました。うまく伝えられなかったようですみません。手順として、検索パターンの修正が先決です。 > また'スペース'には全く意味はありません。 > ワイルドカードでだけで問題ございません。了解しました。 Sub 修正_検索パターン() Dim c As Range 　　Sheets("Sheet2").Select 　　With Cells.CurrentRegion.Offset(1, 1) 　　　　.Replace "　", " " 　　　　.Replace Space$(3), " " 　　　　.Replace Space$(2), " " 　　　　.Replace Space$(2), " " 　　　　.Replace "~* ", "*" 　　　　.Replace " ~*", "*" 　　　　For Each c In .Cells 　　　　　　If InStr(c, " ") Then c = Trim$(c) 　　　　Next 　　　　.Replace " ", "*" 　　End With 　　MsgBox "検索パターンを修正しました" End Sub 上記の修正用マクロを一度だけ実行してください。一旦すべての'スペース'を削除して、ワイルドカードの代用に使っていた'スペース'を"*"に修正します。これを実行した後からは、検索パターンに'スペース'を用いると、それは純粋な意味で'スペース'文字列として扱われます。 'スペース'を含む固有名詞をマッチングすることも可能ですし、 'バングル対策'も有効になります。改めて、[ジュエリー]の検索パターンについては、上記修正マクロ実行後に手作業で注意深く修正を加えて下さい。修正前）　　"ジュエリー" ｜ "バングル"　"ピアス"　"ブレスレット"　"*リング"　"*ネックレス" 修正後）　　"ジュエリー" ｜ "バングル "　"*バングル"　"ピアス"　"ブレスレット"　"*リング"　"*ネックレス" 　　　　　　（末尾にスペース↑　　↑先頭に"*"） ×"バングル*"ではないので、注意してください。 > ⇒合っています！了解しました。これまでのマクロは、すべて削除して、ひとつの標準モジュールに、下記のコード（次の投稿へ続く）を貼り付けてください。　（投稿は２回に分けますが、貼り付ける標準モジュールは１つで足ります。　　Moduke2 は不要になりますので、削除[Moduke2 の解放]して構いません。）実行するマクロは、　[KW分類] 　[メーカーKW分類] の２つです。 [ReG8954513]は[KW分類]と[メーカーKW分類]を共通に処理するように書換えています。検索パターンテーブルのシート名、と、結果出力先列番地、の変更がある場合は [KW分類][メーカーKW分類]側で適用するようにしてください。 ●'バングル対策'は上記の検索パターン修正によってほぼ完結しています。 ●検索パターン修正に伴って、検索パターン整形用の関数Function RevCrit 　の内容が修正されています。 ●結果出力範囲に複数のクラス名を"＋"区切りで連結出来るように書き加えました。 ●[KW分類]、[メーカーKW分類]ふたつの実行マクロから　サブルーチン[ReG8954513]を呼び出すように書換えました。 ●実行前にSheet1がアクティブでないとエラーになる点を修正しました。 ●実行後のオートフルター適用範囲が右側に拡張される点を修正しました。他は、前回と変わらない仕様です。 ' ' /// Sub KW分類() 　　Call ReG8954513(Sheets("Sheet2"), 5)　'　◆シート名？"Sheet2"？　'　◆結果出力先列番地？5？ End Sub Sub メーカーKW分類() 　　Call ReG8954513(Sheets("Sheet3"), 6)　'　◆シート名？"Sheet3"？　'　◆結果出力先列番地？6？ End Sub Private Function RevCrit(ByVal Source As String) As String 　　If (InStr(Source, "*") <> 1) And (InStrRev(Source, "*") <> Len(Source)) Then 　　　　RevCrit = "=*" & Source & "*"　'　両端どちらも"*"が無い　場合は　"*"で括る　　Else 　　　　RevCrit = "=" & Source 　　End If 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 ' ' （次の投稿へ続く）

cj_mover · Answer

失礼、
誤）
完全一致なら
　　"*ネクタイ*"
正）
部分一致なら
　　"*ネクタイ*"

一番重要な箇所で編集ミスしてました。
失礼しました。

cj_mover · Answer

＃１1補足コメントへの返信です。

＃１１で私が書いた、
> > どのような集計/分析をしていきたいのか、俯瞰的/長期的なビジョンを持って、
> > 最終仕様を決めていく ...
> そろそろ ... 熟考の上、最終決定をしてください。
への御返答ということで宜しいのですね。
それでは、お応えします。
> 最後にSheet1のＡ列[キーワード]に対して
> 完全一致を対応することはできるのでしょうか？
> つまりは、「ネクタイ」というキーワードのみのとき、
> "ネクタイ"と設定しておけば、そのキーワードのみと判断させるようなイメージです。
については、検索キーワードテーブル（Sheet2、Sheet3）の中身を
正しくワイルドカードで設定することに統一すれば済むことです。
＃２の時点で確認を求めていたものですが、
こちらが提示したスクリプトでは、
検索キーワードの両端ともにワイルドカード"*"が無いものについては
わざわざ、"*"を両端に付加することで部分一致を実現しています。
この為に書いた記述を削除するだけなので、マクロ側の対処は簡単です。

■手順、以下
１■
検索キーワードをマッチングしたいパターンごとに正しい表記に統一する。
完全一致なら
　　"ネクタイ"
前方一致なら
　　"ネクタイ*"
後方一致なら
　　*"ネクタイ"
完全一致なら
　　"*ネクタイ*"
複数キーワードを並び順で部分一致させるなら
　　"*会社名*ネクタイ*"
２つのキーワードを前方一致*後方一致させるなら
　　"会社名*ネクタイ"
２つのキーワードのうち片方を前方一致、並び順でふたつ目は部分一致させるなら
　　"会社名*ネクタイ*"
などのように、ひとつひとつ手作業で正しい表記に直してください。
記述の通り、検索キーワードもプログラムの一部です。
正確に書くことと、継続的に管理していくことが求められます。
２■
[Sub ReG8954513]の３０行め辺りにある
　　　　　　mtxCritTable(i, j) = RevCrit(sTemp)
を
　　　　　　mtxCritTable(i, j) = "=" & sTemp
に差し替え。
３■
Private Function RevCrit
から
End Function
までの７行、不要になるので削除。
■手順、以上

検証大変だったと思います。ご苦労様でした。
検索キーワードの書き換え、頑張ってください。
それではここら辺で、、、失礼します。

cj_mover · Answer

＃１０補足コメントへの返信です。

> シート保護でエラーがでてました。
> cj_moverさんのプログラムで直りました！

それは良かったです。

> ただ新たに課題がでてきたのが、メーカー名が2文字でキーワードにスペースがないパターン。
> 例:"まゆスニーカー"というキーワード
> メーカー名が「まゆ」商品名「スニーカー」
> 返ってほしい語が「まゆ＋靴用品」
> 設定で、"まゆ*"にしてしておくと、"まゆげ"とか"まゆゆ"とか"まゆみ"とかまで引っかかってしまいます。
> このスペースなしのキーワード対策はもはや無理ですかね？

Sheet1のＡ列[キーワード]項目の内容（運用規則漏れ）に関する課題
ということだと思いますが、
例えば仮に、「ひらがなとカタカナの間には'スペース'があると看做して」
というような処理をさせることも可能は可能です。
でも一部の特例の為に、他の通常処理に齟齬がでる可能性がありますね。
リスクを回避する意味でも、データソースに関することは、
解析処理とは切り離して処理する方が好ましいこと思います。
Sheet1のＡ列[キーワード]項目について、
"まゆ"の後にカタカナが続く場合は、間に'スペース'を挿入するようにする、
作業自体は、オートフィルターで文字列フィルターを実行すれば、
手作業でもさほどの労力を必要としない気もします。
（例えば、Word等の高機能テキストエティターなら結構簡単。）
難しいようでしたら、別途マクロを求めてみては如何でしょう。
ただ、今回のこの質問スレでは、申し訳ないけれどこの課題については
お応えするつもりはないので、別件として、新たな質問を建ててみて下さい。
どのような方法を採るにしても、
'メーカー名'と'商品名'を区別するのは、人間ですから、
マクロにしてもExcel数式にしても、どうやって区別を付けるのか、
という論理を人間が明確に指示してあげる必要があります。
また、そうした論理付けは、
具体物（≒ダミーサンプル）を手にしている当事者にしか
判らないこと、だということにも、注意する必要があります。
> 無理ですかね？
決して無理ではないでしょうけれど、コミュニケーション的に
困難ではありますね。

> あと設定してないキーワードがあればそれもわかるようにしたいのですよね。
ちょっと意味が解り難いですが、
Sheet1のＡ列[キーワード]項目のことではないですよね？
SHeet2やSHeet3の検索キーワードテーブルの漏れを埋めていきたい、
ということでしたら、
それは、今回課題のマクロを実行した上で、
Sheet1のＥ列[ＫＷ分類]とＦ列[ﾒｰｶｰＫＷ分類]に[オートフィルター]を掛けて、
視認しながら、検索キーワードの補完を手作業でしていくことになるでしょう。
[オートフィルター]で[(空白セル)]を選択するとか、、、。
そういった作業を補佐する資料を今回のマクロに盛り込めるかどうか、
でいえば、まったく別の処理になりますから、
何か付け足して簡単に済むような話ではありません。
また、そういった処理が可能になる絶対的な前提として、
データソース、つまり、
Sheet1のＡ列[キーワード]項目の内容
が、確実に'スペース'で区切られていることが必須条件です。
喩えていえば、Ｂ列にあるべきデータがＡ列のデータに結合されてしまっている、
のと同じような状態にある訳ですから、単純な論理で区別できるものではないですね。
やはり、データソースの整形、というのは、解析作業とは別物です、とお応えするしか、、、。

データソースの不備はこの際無視してでも、
全面的に設計からやり直して、そういう機能を盛り込みたい、
ということであれば、＃２-＃１０まではまったく役に立たないので、
全部なかったことにして、ここで一からやり直してもいいですよ。
＃２でも触れましたが、
> どのような集計/分析をしていきたいのか、俯瞰的/長期的なビジョンを持って、
> 最終仕様を決めていく ...
そろそろ最終決定、というお話にして貰えたらば、ということですね。
私個人のリアルの予定として、4/15以降は数週に渡って、
これまでのように検証作業に重みがある厚量の回答をする時間が取れません。
どこまで出来るか約束はできませんけれど。

話、整理しますが、
データソースの整形、に関しては別件でお尋ねください。
設計の見直し、ということであれば、熟考の上、最終決定をしてください。

＃１０補足コメントへの返信は、以上です。

cj_mover · Answer

＃８への追記です。度々すみません。

もし原因が[シートの保護]の適用にあれば、以下は必要な話ではありませんが、
もうひとつ、環境因でのエラーの可能性に気が付きました。
当らずとも保険を掛ける意味で、念の為、
[ReG8954513]の下から13行め辺りの、
　　.UsedRange  '  ●＃３解答後に追記
この行↑を
　　i = .UsedRange.Row '  ●＃３回答後に追記＃８回答後に変更
この行↑に差し替えておいてください。

また、将来的に前提を忘れた頃にシートレイアウトを変更するとかで、
同様のエラーで頭を悩ませる可能性もありますから、これも保険的処置ですが、
どこでエラーが起きているのか判り易くする為に、
[ReG8954513]の下から19行め辺りの、
Exit_:
    .Cells(1).Select
この↑２行を
Exit_:
    If Err Then MsgBox Err & vbLf & Err.Description:    Err.Clear
    On Error GoTo 0
    .Cells(1).Select
この↑４行に差し替えておいてください。

＃８への追記は、以上です。

cj_mover · Answer

＃８への訂正です。

[シートの保護]を適用していることがエラーの原因であった場合についてですが、
＃８で提示した対策では、
Sheet1だけは、[オートフィルターの使用]を許可するように
再設定しれあげないといけないことをうっかり忘れていました。

Private Sub Auto_Open()
　　Sheets("Sheet1").Protect Password:="", UserInterfaceOnly:=True, AllowFiltering:=True '  ◆シート名？"Sheet1"？ パスワード?""?
　　Sheets("Sheet2").Protect Password:="", UserInterfaceOnly:=True '  ◆シート名？"Sheet1"？ パスワード?""?
　　Sheets("Sheet3").Protect Password:="", UserInterfaceOnly:=True '  ◆シート名？"Sheet1"？ パスワード?""?
End Sub

以上、[シートの保護]を適用するシートの行だけを残して、
不要な記述を削除したもの、に差し替えてやってください。
[オートフィルターの使用]以外にも
[このシートのすべてのユーザーに許可する操作]の設定を変更している場合は
それぞれ手当てが必要になりますので、必要なら、ご相談ください。

＃８への訂正は、以上です。

cj_mover · Answer

＃６補足コメントへの返信です。

> ただ最初は動いたのですが、急に下記の場所で、
> 「実行時エラー 91 オブジェクト変数または with ブロック変数が設定されていません」
> とエラーがでるようになったのですが、これはどういう意味なのでしょうか。

> Exit_:
> .Cells(1).Select
> rngCriteria.Clear　←←←ここでエラーが起きます。

実際には、[ReG8954513]の40行め辺り、
        Set rngCriteria = .Cells(.Rows.Count + 2, 1).Resize(nCritMaxSize, nClassCount)
の行より前の処理でエラーが起きていることになります。
その部分でエラーが起きる原因としては、主に、
１●処理に関わる３つのシートのいずれかでレイアウトを変更している場合。
２●処理に関わる３つのシートのいずれかで[シートの保護]を適用した場合。
のふたつが考えられます。他の可能性は低いです。
「どこのセル」という問い合わせから始まり、具体的なサンプルブックを用意され、
情報を共有しながら開発にあたっていますから、１●はないでしょう。
[シートの保護]を適用している場合に限りますが、２●についての対策が以下。

Private Sub Auto_Open()
　　Sheets("Sheet1").Protect Password:="", UserInterfaceOnly:=True  '  ◆シート名？"Sheet1"？ パスワード?""?
End Sub

標準モジュールであれば、何処に書いても構いません。
「シート名」と
「パスワード」を設定している場合は「パスワード」
の指定を確実に実践してください。
　（... Password:="1234", ... のように）
また、複数のシートで[シートの保護]を適用している場合は、
[シートの保護]を適用しているシートの数だけ、
　　Sheets("Sheet1").Protect ... 
　　Sheets("Sheet2").Protect ... 
　　Sheets("Sheet3").Protect ... 
のように、【必要なだけ】行数を増やして対応してください。
[Auto_Open]を記入し終わったら、
[Auto_Open]の記述内をクリック（選択状態に）してから。
[F5]キーを押して実行します。
上書き保存をしておけば、以降は、ブックを開く度に自動実行されます。

以上で解決しない場合は、
　　On Error GoTo Exit_
の行の先頭に ' を付加して、
'　　On Error GoTo Exit_
のように書換えてから実行して、
実際にエラーになっている行を確かめることと、
提供されたサンプルブックと、実行環境とで、
特長的な相違点がないか、探してみてください。
実は、シンプルにシート名の指定を誤っても起こり得るエラーではあります。

原因がハッキリしたならば、
再発防止に向けて修正が必要な場合は、対応します。
現状、提供されたサンプルブックそのままでは、起りえないエラーですので、
そちらでの確認待ちになります。

＃６補足コメントへの返信は以上です。

cj_mover · Answer

＃５,６に追記です。

＃５,６の[KW分類]や[メーカーKW分類]を実行すると
ＶＢＥのイミディエイトウィンドウに、
各クラス名と、マッチした件数を表示するようになっています。
また、各検索パターンに'検索条件不正'がある場合の確認にも使えます。
イミディエイトウィンドウはＶＢＥ（ＶＢＡ編集画面）にて
[Ctrl]+[G]キーを押すとアクティブになります。
もし使い途が無いというような判断であれば、
[ReG8954513]の記述中、２カ所、
Debug.Print ... の行を削除しても構いません。

追記、以上です。

cj_mover · Answer

' ' （前の投稿の続き）

Private Sub ReG8954513(ByVal wksTable As Worksheet, ByVal nResCol As Long)
Dim Target　　　　　As Range　'　検索対象範囲
Dim rngCriteria　　 As Range　'　Criteria（フィルター条件）設定範囲
Dim rngResultArea　 As Range　'　出力先セル範囲
Dim rngAppendResult　 As Range　'　追加出力先セル範囲
Dim c As Range
Dim mtxCritTable() As Variant　'　Criteria（先頭はClass名）二次元配列
Dim arrCritYSize() As Long　'　Criteria ブロック毎の各サイズを格納する一次元配列
Dim sTemp As String　'　Criteria 個々の条件を整形する為に一時的に格納する変数
Dim sResult As String　'　結果（クラス名
Dim sAppend As String　'　追加用結果（＋クラス名）
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 = wksTable.Cells.CurrentRegion.Value
　　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"？
　　.Select　'　●＃３解答後に追記
　　blnFilter = .AutoFilterMode
　　If blnFilter Then .AutoFilterMode = False

　　With .Cells.CurrentRegion
　　　　Set Target = .Columns(1).Cells
　　　　Set rngResultArea = .Cells(2, nResCol).Resize(.Rows.Count - 1)
　　　　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　'　抽出された件数
　　　　　　　　sResult = mtxCritTable(i, 1)　'　結果（クラス名）
　　　　　　　　If cntRes Then　'　抽出された件数が１つ以上であれば、
　　　　　　　　　　sAppend = "＋" & sResult　'　追加用結果（＋クラス名）
　　　　　　　　　　rngResultArea.SpecialCells(xlCellTypeVisible).Select

　　　　　　　　　　If cntRes > 1 Then　'　抽出された件数が２つ以上であれば
　　　　　　　　　　　　' ' 出力先セル範囲 の 抽出された可視範囲 の 既に値のあるセル に クラス名を追加
　　　　　　　　　　　　On Error Resume Next
　　　　　　　　　　　　Set rngAppendResult = Selection.SpecialCells(xlCellTypeConstants)
　　　　　　　　　　　　On Error GoTo Exit_
　　　　　　　　　　　　If Not rngAppendResult Is Nothing Then
　　　　　　　　　　　　　　For Each c In rngAppendResult
　　　　　　　　　　　　　　　　c = c & sAppend
　　　　　　　　　　　　　　Next
　　　　　　　　　　　　　　Set rngAppendResult = Nothing
　　　　　　　　　　　　End If

　　　　　　　　　　　　' ' 出力先セル範囲 の 抽出された可視範囲 の 空白セル に クラス名を出力
　　　　　　　　　　　　On Error Resume Next
　　　　　　　　　　　　Selection.SpecialCells(xlCellTypeBlanks).Value = sResult
　　　　　　　　　　　　On Error GoTo Exit_
　　　　　　　　　　ElseIf ActiveCell = "" Then　'　抽出された件数が１　且　空白セルであれば
　　　　　　　　　　　　ActiveCell = sResult　'　クラス名を出力
　　　　　　　　　　Else　'　抽出された件数が１　且　既に値のあるセルであれば
　　　　　　　　　　　　ActiveCell = ActiveCell & sAppend　'　クラス名を追加
　　　　　　　　　　End If
　　　　　　　　　　Debug.Print sResult, cntRes
　　　　　　　　End If
　　　　　　Else
　　　　　　　　cntIrr = cntIrr + 1
　　　　　　　　Debug.Print sResult, "検索条件不正"
　　　　　　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
　　.UsedRange　'　●＃３解答後に追記
　　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

cj_mover · Answer

こんにちは。

> この２つの課題が解決できないでしょうか。
できるでしょうし、技術的には難しいことでもなさそうと予想していますが、
どんな解決策を選ぶのが良いか、という選択が難しいです。
運用面がとても重要になってくるので、
そこら辺で何が可能かどうか、見定めないとなりません。

「マッチング」と呼ぶぐらいですから、
マッチングさせたい検索キーワードパターンは適切なものでないとなりません。
#3補足でリンクされたサンプルでは、
検索パターンの中に、
'スペース'が無作為に紛れ込んでいます。
本来は'スペース'も"*"などの記号も、
「マッチング」にとっては重要な意味役割を持つものです。
例えば、
"ゴルフ ボストン"
は、正しく、
"ゴルフ*ボストン"
と表記する。
例えば、
"* リング"　→　"*リング"
例えば、
" iphone"　→　"iphone"
など、適切な設定をしないと求める結果は得られません。
検索パターンはプログラムの一部です。
プログラムで余分な'スペース'を書き足したら、大抵の場合、処理は不正に終ります。
もっとも、'スペース'とマッチさせる意味で'スペース'を指定することはできますが、
その場合は、ワイルドカードを"*"に統一する必要があります。
そういう運用が可能、ということでしたら、
先のマクロを多少変更するだけで済みます。
●無駄なスペースを排除する。
●ワイルドカードを"*"に統一する。
という作業を実践する前提で、以下に、ひとつの答えを書きます。

"バングルーブ"と"バング"の問題については、
差し当たり、
"バング"というひとつのキーワードで済ませているものを、
"バング "　"*バング"
（末尾にスペース、先頭に"*"）
というふたつのパターンで表現するように換えれば、
比較的簡単に当座の問題は解消されます。
後は、運用の問題として、
新しい検索パターンを入力する度に、
そのパターンが、既存の他のパターンに部分一致しないかどうか確認した上で、
もし、部分一致した場合は、上記のようにパターンを書き分ける、
という規則を適用することで、対応できるのでは、と思います。
=COUNTIF(Sheet2!B1:H23,"*バング*")
みたいな関数でも簡単にチェックできますし、
自動でチェックできるマクロ（イベントマクロ）を用意する手もあります。

> ②二つのキーワードがきた時、○○＋○○とでるようになってほしい。
確認ですが、
複数の条件にマッチした場合、
[ＫＷ分類]の結果出力範囲のひとつひとつのセルについて、
マッチした結果のすべてを
　　"＋"　　全角+
を区切り文字に指定して
連結した文字列を返す、
ということで合っていますか？
例えば
 　　"会社A" ｜ 会社A*"
　　"スポーツ" ｜ "ゴルフ"　"golf"
　　"バッグ" ｜ "バッグ"　"bag"
というテーブルがあった場合、
Sheet1のＡ２が、
　　"会社A ゴルフバック"
なら、Sheet1のＥ２には、
　　"会社A＋スポーツ＋バッグ"
のように。

とりあえず、以上の確認を待ってから具体的な対策をします。
検索パターンの修正が難しいようでしたら、
'スペース'に込められた意味付けを説明して貰えれば、
こちらでも対応できるようになるかと思います。
手数が掛かって大変でしょうけれど、返信、お待ちしています。

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

＃４補足コメント拝見しました。

失礼、

＃１1補足コメントへの返信です。

＃１０補足コメントへの返信です。

＃８への追記です。

＃８への訂正です。

＃６補足コメントへの返信です。

＃５,６に追記です。

' ' （前の投稿の続き）

こんにちは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング