ファイル名の曖昧検索も欲しい

投稿日: 投稿者:

KASAです
前回はよくわからないフォルダの中にどんなファイルがあるのかを知る方法を書きました


これであらかたのフォルダ構成とそこにどんなファイルがあるかは把握できました
ただこれだけではたくさんのファイルがあることが判っただけで、自分が見たいファイルを探すにはまだ不十分です
ファイルを探す時に完全なファイル名を覚えていれば良いですが、曖昧にしか覚えていないことが結構あると思います
それ以外でも似たような名前のファイルを探したいことも出てきます
ファイルエクスプローラでもある程度はできますが、なかなか思った通りの結果は得られないことが多いです

 

 

先日作成したファイル一覧のファイル名の列部分でExcelのフィルタ機能を使うことでそれなりの検索もできます

フィルタ機能には正規表現はありませんが、ワイルドカードがあるので曖昧検索が可能です

当初はそれでやっていたのですが、ワイルドカードでは対象に入らなかったものは除外されるので
ワイルドカードの書き方に結構注意が必要になります
そこでフィルタで絞り込むのではなく、類似度を計算してソートする方法を考えてみました

これだと順位は下がることはあっても除外されることは無くなります


まずはGoogle先生に「レーベンシュタインの距離の概念」を利用することを教えてもらって実装しましたが、なんかイマイチでした
知りたい人はググってください

最大の問題は「文字列長に大きく左右されるので検索元の文字列が短いと検索先文字列に完全に含まれていても評価が下がる」点でした
長さを含めてかなり正確に検索元ファイル名を決めないと効果が低いので、長いファイル名の一部しかわからない時にはほぼ検索できないことになります

これでは不便すぎるため自前で理屈を考える必要が出てきました
考えた方法はこんな感じ

１）検索元文字列の各文字が検索中の文字列に左から順に含まれている（並び順が同じ）かどうかをチェックする

２）その時、連続して現れる場合ポイントを高く、間に別の文字は挟まった場合なポイントを低く加算する

例）検索元：ABCD と　検索対象文字列：ABXC
　　　検索対象文字列のAは開始基準、BはAに隣接で評価高、CはBより右にあるが間に別の文字があるので評価低、Dはないので評価無

３）それだとABCDに対してABXCとXXXABXCXXXXXXが同評価というのもちょっとよろしくないので
文字列長の合致度をわずかに追加する（順位の入替）

最初はこれを実装して利用しましたが、以下の点でしっくりこないのでオプションを追加しました

問題点：単語などの順番も曖昧な場合、順番が入れ替わると一気にポイントが下がる
たとえは「気温湿度管理」なのか「湿度気温管理」なのか曖昧の場合
検索元を「気温湿度管理」として実は「湿度気温管理」だった場合は「湿度」が先に来てしまうため、雰囲気は似ているのに評価が低くなる

この部分をフォローするため、上の1）～３）の評価に加えて、

４）検索元の文字が順番にかかわらず検索対象文字列に含まれる場合には1文字づつ少し(低より低い)ポイント加算する

オプションを追加しました。

結果的には「レーベンシュタインの距離の概念」よりも自分のイメージに近い結果となり、現在絶賛実用中です

しかし自分の頭のイメージを実装するのは意外と面倒ですね

以下に実装方法を記載しましたので、同じような悩みをお持ちの方はやってみてください

元になるExcelシートの作成
新規でExcelを開きます
先頭シート(Sheet1)のシート名を「類似検索」とします
「開発タブ」から「Visual Basic」を起動し、「Sheet1（類似検索）」をダブルクリックして選択します

右の編集枠内に以下を貼り付けます

‘＝＝＝＝＝ここから＝＝＝＝＝
Dim 停止フラグ As Integer
   
Sub 類似検索()
    Dim ベース文字列 As String
    Dim ベース文字長 As Integer
    Dim 比較用文字列 As String
    Dim 比較開始位置 As Integer
    Dim 仮ポイント As Double
    Dim 最大ポイント As Double
    Dim 検索文字 As String
    Dim 検出位置 As String
    Dim 次の文字 As String
    Dim 次の位置 As String
    Dim 差長 As Double
    Dim ベース文字位置 As Integer
    Dim ベース次文字位置 As Integer
    Dim 処理行位置 As Integer
    Dim 最終行 As Integer
    Dim 理想ポイント As Double
    Dim 前方補完 As Double
   
    停止フラグ = 0
   
    ベース文字列 = Cells(2, 1)
    ベース文字長 = Len(ベース文字列)
    仮ポイント = 0
   
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row
    前方補完 = 0
    If CheckBox1.Value Then
        前方補完 = ベース文字長 * 0.1
    End If
    理想ポイント = (ベース文字長 - 1) * 2 + 前方補完
   
    '基準表示
    Cells(2, 2) = ベース文字長
    Cells(2, 3) = 理想ポイント + 0.0001
    Cells(2, 4) = 100#
   
   
   
For 処理行位置 = 3 To 最終行

    DoEvents
    If 停止フラグ = 1 Then
        Exit Sub
    End If
   
    比較用文字列 = Cells(処理行位置, 1)
    Cells(処理行位置, 2) = Len(比較用文字列)
   
    最大ポイント = 0
    仮ポイント = 0
    比較開始位置 = 1 '検索開始位置
   
    '検索元のi文字目から検索
    'For i = 1 To ベース文字長
    ベース文字位置 = 1
    Cells(1, 5) = 処理行位置 & " / " & 最終行
   
    '前方保管量計算
    前方補完 = 0
    If CheckBox1.Value Then
        For i = 1 To ベース文字長
            検索文字 = Mid(ベース文字列, ベース文字位置, 1)
            '先頭位置(検出位置)
            If InStr(比較開始位置, 比較用文字列, 検索文字) <> 0 Then
                前方補完 = 前方補完 + 0.1
            End If
        Next i
    End If
   
   
    While ベース文字位置 <= ベース文字長
        '検索文字選択
        検索文字 = Mid(ベース文字列, ベース文字位置, 1)
        '先頭位置(検出位置)
        検出位置 = InStr(比較開始位置, 比較用文字列, 検索文字)
        If 検出位置 <> 0 Then
            '検索文字あり（以降の文字を捜す）
            For ベース次文字位置 = ベース文字位置 + 1 To ベース文字長
                '2文字目以降
                次の文字 = Mid(ベース文字列, ベース次文字位置, 1)
                次の位置 = InStr(検出位置 + 1, 比較用文字列, 次の文字)
                '対象文字無し
                If 次の位置 = 0 Then GoTo CONTINUE_I
                '文字あり
                If (次の位置 - 検出位置) = 1 Then
                    '隣接
                    仮ポイント = 仮ポイント + 2
                Else
                    'それ以外（後方）
                    仮ポイント = 仮ポイント + 1
                End If
                '先頭1文字ずらす
                検出位置 = 次の位置
CONTINUE_I:
            Next ベース次文字位置
        Else
            'i文字目なし 次の文字
            ベース文字位置 = ベース文字位置 + 1
        End If
        '文字列長を配慮
        差長 = Abs(Len(比較用文字列) - Len(ベース文字列))
        差長 = 差長 / (Len(ベース文字列)) * 0.1
        仮ポイント = 仮ポイント - 差長 + 前方補完
        If 最大ポイント < 仮ポイント Then
            最大ポイント = 仮ポイント
        End If
        仮ポイント = 0
        比較開始位置 = 検出位置 + 1
       
    'Next i
    Wend
   
    Cells(処理行位置, 3) = 最大ポイント
    Cells(処理行位置, 4) = 最大ポイント / 理想ポイント * 100#
   
Next 処理行位置

End Sub

Sub 停止()
  停止フラグ = 1
End Sub

Sub ポイントクリア()
'
' ポイントクリア
'
    Range("C3:D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.End(xlUp).Select
    ActiveWindow.ScrollRow = 3
    Range("C3").Select
End Sub

Sub 並べ替え()
'
' 並べ替え
'
    Columns("A:D").Select
    ActiveWorkbook.Worksheets("類似検索").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("類似検索").Sort.SortFields.Add2 Key:=Range( _
        "C2:C16602"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    maxRow = Cells(Rows.Count, 1).End(xlUp).Row
    With ActiveWorkbook.Worksheets("類似検索").Sort
        .SetRange Range(Cells(1, 1), Cells(maxRow, 4))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("A1").Select

End Sub

Private Sub CheckBox1_Click()

End Sub
‘＝＝＝＝＝ここまで＝＝＝＝＝

シートのレイアウト

類似検索シートを以下のようにします（赤字は説明用なので無視してください）

ボタンの作成方法は以下のように選択して、上のイメージに合わせてマウスのラバーバンドで位置と大きさを決めてください
マクロの登録時には、上のボタンの名前と同じマクロを選択してください


上の手順でチェックボックスを１つ追加してください

これで一応出来上がりです

準備

このままでは検索されるファイル名もないのでなにもできません
実行する前の手順としては
まずこのシートのA3セル以下に、前に取得したファイル一覧のファイル名を貼り付けます
この時にA列の表示書式は必ず「文字列」になるように貼り付けてください
そうしないと処理中にエラーになることがあります。（大抵そのセルが「＃NAME」となっています）

行全体を「文字列」設定しても貼り付け時に勝手に崩れる場合があります
その時は再度そこの表示書式を設定するか、おとなしくエラーとなった文字列の先頭に「’」をつけてデータ自体を文字列にしてしまう方が早いかもしれません

一度ファイル名を入れてしまえばあとはそれを使うだけなので最初だけの作業です

実行

「A2」セルに探したい（曖昧な）ファイル名を入力します。

「類似検索」ボタンを押下すると実行が始まり「E1」セルに検索状況（評価済数/全体数）が表示されます

実行中は前のポイント値を上書きしていきます（最初にクリアされません）
必要に応じて実行前に「ポイントクリア」ボタン押下でポイントなどの数値部をクリアしてください

途中で止める場合は「停止」ボタンを押下します（停止後は先頭からしか実行できません）
処理が完了したら「並べ替え」ボタンを押下すると類似度が高い順にファイル名がソートされます

 

前方補完(チェックボックス)について

チェックがない場合、検索元(A2セル)の文字の並び(左から右)の順序が厳格になり、順序が入れ替わった場合評価（ポイント）は上がりません
チェックがある場合は前後が入れ替わっても同じ文字があれば評価（ポイント）は上がります

最後に

ほぼコピペで済む感じにはしたつもりですが、不明な点はGoogle先生にお尋ねください
最近流行りのChatGPTとかに尋ねるともっとすごいやつを作ってくれるかもしれません（うまくいった方せひご一報ください！）
どうしてもわからないけど使いたい！という方は弊社のお問い合わせから何か一言添えて連絡ください

メールアドレスの記載があれば今回作成したExelファイルを送付します。（マクロ付きのExcelが添付で受信できることが前提です）
ただ大量のリクエストがあった場合などは応じきれない可能性もあります、その節は「まあ零細企業のブログやしな」と生温かく見逃してくださいませ

仕事は楽しくできるに限ります
面倒なことを立ってくれるものとしてコンピュータは生まれたはず
コンピュータを使う仕事で苦労するのはおかしいと思いませんか？
楽するためにちょっとだけ苦労する

その苦労も楽しめれば最高ですよね

「そのと～り」と思われる方、一緒に仕事しませんか？
また、「この繰り返し作業かったるくて、何とかして～」という方ご相談にのれるかもしれません