一致率で絞り込んでみる（本棚ツールの改修）

以前、家の本棚を図書館っぽく検索するツールを作成した。
infoment.hatenablog.com

少しだけおさらいすると、こんな感じだ。
まず、書籍リストを一つ準備する。

次いで、本棚を含む部屋の簡易レイアウト図を作成する。
↓ では、１－Ａ～１－Ｃが本棚だ。

本棚を選択して右クリックすると、検索用ユーザーフォームが起動する。
ユーザーフォームには、選択中の本棚にある本が表示されている。

題名検索では、入力した書籍名で、書籍候補が絞り込まれていく。

しかしこの方法だと、例えば「ハリー・ペッター」と入力した時点で、候補から除外されてしまう。熱烈なファンからは、怒りも買ってしまう。
そこで、昨日の「レーベンシュタイン距離」を用いた絞り込みに変更してみる。
infoment.hatenablog.com

ユーザーフォーム（BookShelfForm）

まず、検索結果を表示するListBoxのプロパティを変更する

プロパティ	値	備考
ColumnCount	3	一致率表示用に列を追加
ColumnWidths	200;0	書籍名称表示列の幅を充分に確保。 2列目は書籍の通し番号で表示不要。

一致率を追加したリスト用に、配列を追加する。

Option Explicit
    ' 今回追加
    Dim BookList() As Variant

Private Sub UserForm_Initialize()
    Call InitUserform
    Call SetBookShelfListBox
    
    ' 今回追加
    ReDim BookList(1 To UBound(Books), 1 To 3)
        
End Sub

次いで、テキストボックスの値と各書籍名称の一致率を求め、リストに追加する。

Private Sub TextBox1_Change()
    Dim str1  As String
        str1 = TextBox1.Value
    Dim str2 As String
    Dim i As Long
    Dim j As Long
        j = j + 1
    Dim MatchRatio As Long
        For i = 1 To UBound(Books)
            str2 = Books(i).書籍名称
            MatchRatio = Levenshtein3(str1, str2)
            BookList(i, 1) = str2
            BookList(i, 2) = j
            BookList(i, 3) = MatchRatio
            j = j + 1
        Next
        ListBox1.Clear
        ListBox1.List = BookList
End Sub

結果は以下の通り。
100％一致するものはもとより、「似ている書名」も解るようになった。

さすがに、０％のものまで表示する必要は無いので、例えば50％以上一致するものだけ表示してみる。
さらに絞り込むことが出来た。また「ハリー・ペッター」で検索しても、それなりの候補を選んでくるようになった（正しい書名とは、一致率９２％でヒット）。

ところで、毎回「一致率５０％」が適切かどうかは分からない。そこで、これを更に改良してみる。

というわけで次回、一昨日の「あれ」が出てきます。

参考まで。