検索キーワードがヒットした文節を抽出するマクロ（ファイル有）【バッチリExcel相談室 #003】

バッチリ

タイトルの件、以前にツイートしたのですが、

関数でやるとなると少し歪になり、好かんなと思ったので、Excel VBAで作りました。

画面イメージはこんな感じ。

突貫なので、使用場面に応じて、他のファイルを参照したり直接セルに書き込んだりすることもあるでしょう。とりあえずこんな感じで。

今回はこちらを配布いたします。

ソースコード

ソースコードはこちらです。

Option Explicit  '変数の宣言を省略できない

'**************** 定数 ****************
'名前の定義
Const NM_KEY = "検索キーワード"
Const NM_DLM = "区切り文字"
Const NM_TGT = "検索対象文字列"
Const NM_RES = "ヒット箇所"
'区切り文字
Const STR_DLM = "区切り文字"
'**************************************

'************** メソッド **************
'引数：なし
'戻り値：なし
Sub 検索()
   
   'シートに入力した情報を保持する変数の宣言
   Dim colKey As Collection    '検索キーワード
   Dim colDlm As Collection    '区切り文字
   Dim colTgt As Collection    '検索対象文字列
   
   '各入力情報をコレクションで保持
   Set colKey = getCollection(NM_KEY)  '検索キーワード
   Set colDlm = getCollection(NM_DLM)  '区切り文字
   Set colTgt = getCollection(NM_TGT)  '検索対象文字列
   
   '検索キーワードへの入力が０個の場合、終了
   If colKey.Count = 0 Then
       MsgBox "検索キーワードを入力してください。"
       Exit Sub
   End If
   '検索対象文字列が０個の場合、終了
   If colTgt.Count = 0 Then
       MsgBox "検索対象文字列を入力してください。"
       Exit Sub
   End If
   
   'ヒット箇所（出力先）を配列で保持（Rangeに代入するので二次元配列）
   Dim aryOut() As Variant
   ReDim aryOut(1 To colTgt.Count, 1 To 1)
   
   'ヒット箇所の値をクリア
   clearResult NM_RES
   
   'aryOutのインデックス
   Dim outIndex As Long
   outIndex = 1  '出力位置の初期化
   
   '検索対象文字列ごとにループ
   Dim tgt As Variant
   For Each tgt In colTgt
       
       '検索対象文字列を文節に区切るために、一種類の区切り文字に変換
       Dim dlm As Variant
       For Each dlm In colDlm
           tgt = Replace(tgt, dlm, STR_DLM)
       Next dlm
       
       '区切った分だけ繰り返し
       Dim subTgt As Variant
       For Each subTgt In Split(tgt, STR_DLM)
           
           '検索キーワード全通り判定するため繰り返し
           Dim key As Variant
           For Each key In colKey
               
               'ヒット（部分一致）した場合
               If (subTgt Like "*" & key & "*") Then
                   
                   '2回目以降ヒットなら、改行する
                   If Not aryOut(outIndex, 1) Like "" Then
                       aryOut(outIndex, 1) = aryOut(outIndex, 1) & vbNewLine
                   End If
                   
                   '結果の文節（subTgt）を配列に保持する
                   aryOut(outIndex, 1) = aryOut(outIndex, 1) & subTgt
                   
                   'キーワードループから抜ける
                   '（一つの文節に複数のキーワードが引っ掛かっている可能性があり、
                   '　抜けないと同じ文節が出力されてしまうため。）
                   Exit For
                   
               End If
               
           Next key
           
       Next subTgt
       
       '次の出力先へ
       outIndex = outIndex + 1
       
   Next tgt
   
   '出力先のセル情報（ヒット箇所の下のセルから出力配列分下の行までリサイズして取得する）
   Dim rngOut As Range
   Set rngOut = ShtExecute.Range(NM_RES).Offset(1, 0).Resize(UBound(aryOut, 1), 1)
   
   'シート保護の解除
   ShtExecute.Unprotect
   
   'セルに値貼り付け
   rngOut = aryOut
   
   'シート保護
   ShtExecute.Protect
   
   MsgBox "検索が終了しました。"
   
End Sub

'指定された名前定義の参照セルのデータをコレクションとして返す
Private Function getCollection(nm As String) As Collection
   
   '指定された名前定義の参照セルの１行下からデータ
   Dim rng As Range
   Set rng = ShtExecute.Range(nm).Offset(1, 0)
   
   '返却用コレクション
   Dim c As New Collection
   
   'セルの値が空になるまで繰り返し
   Do Until rng.Value Like ""
       
       'コレクションに追加
       c.Add rng.Value
       
       '次のセルへ
       Set rng = rng.Offset(1, 0)
       
   Loop
   
   '返却
   Set getCollection = c
   
   'メモリ解放
   Set c = Nothing
   Set rng = Nothing
   
End Function

'指定された名前定義の参照範囲セルの値をクリア
Private Sub clearResult(nm As String)
   
   '名前の定義よりセル情報を取得
   Dim rng As Range
   Set rng = ShtExecute.Range(nm)
   
   With ShtExecute
       
       'シート保護の解除
       .Unprotect
       
       'セルの値をクリア
       .Range(rng.Offset(1, 0), _
              .Cells(.Rows.Count, rng.Column).End(xlUp)) _
                   .ClearContents
       
       'シート保護
       .Protect
   
   End With
   
   'メモリ解放
   Set rng = Nothing
   
End Sub

解説

1.入力チェック

・キーワードは入力してください。
・対象文字列も入力してください。

2.各入力情報を保持

それぞれ、配列に保持します。処理速度最強ね。今回の場合は配列じゃなくてもいいかも。

3.検索対象文字列の行ごとにループ
　3.1.検索対象文字列を区切り文字で分割（文節）
　3.2.文節ごとにループ
　　3.2.1検索キーワードごとにループ
　　　3.2.1.1.検索キーワードが文節にヒットする場合、出力
　　　3.2.1.2.次の文節へ

ループの順番をどうするか、を考えるのが大事ですよね。
今回の場合は、検索対象文字列ごとに処理していきます。
上記の通りなので解説のしようもないですね。
あ、文字列の部分一致はLike演算子をつかって、keyの両端にアスタリスク（*）をつけてます。Excel VBAで使える正規表現ですね。Instrでも良いんですけど別に何文字目にあるかとか使わないので。

4.出力

出力します。

ちなみに、この1~4を最初にコメントしておくと、コーディングしやすいです。

ファイルダウンロード

作成したファイルを配布します。利用に際してをご覧の上、用法用量を守って正しくお使いください。

利用に際して

・配布しましたExcelマクロファイルは学習用ですので、商用利用や悪用利用、無断配布、複製はお断りしております
・利用により発生した損害については、当方は一切責任を負いかねます
・デジタルコンテンツの性質上、返金はいたしかねます。コンテンツの内容につき不備がございましたら、ご連絡くだされば更新いたします
・ソフトウエア著作権は、当方に帰属します

※マガジンをご購入いただきますと特典としてExcel相談ができます。
　内容によってはオーダーメイドファイルをnoteで公開いたします。
　相談はTwitter DMまで！ぜひ！

疑問点不明点等ございましたら、お問い合わせください。

バッチリ

ここから先は

0字

¥ 100

この記事が気に入ったらサポートをしてみませんか？