リストの絞り込み の続き③ ～ 重複する名前を別物として認識させる ～

昨日は選択した本の所在を、レイアウト図で見える化してみました。

infoment.hatenablog.com

しかし実は、昨日までの方式には、ある重大な欠陥があります。それは、同じ題名の本が複数冊ある場合に対応できない点です。例えば、「ソラリスの陽のもとに」という本が「１－Ｂ」と「１－Ｃ」に一冊ずつあるとします。

ユーザーフォームで表示させた場合、リストボックスには同じ名前が二つ表示されます。しかしこの方式では、コレクションの中身を検索し、先に見つけた方の情報が表示されてしまうため、今回はどちらとも「１－Ｂ」が選択されてしまっています。

そこで、同じ題名であっても別物として区別できる印が必要なります（以降「キーコード」と言います）。今回は区別できれば何でもよく、コード自体には意味のない「無為コード」でもＯＫです。そこで、コレクションに追加する内容に、「通し番号」を加えてみました。

↓クラスモジュール（一行追加）

Public 本棚番号 As String
Public 書籍名称 As String
Public 著者氏名 As String
Public 通し番号 As Long     ' 今回追加した箇所

Public Property Get Self() As BookShelfClass
    Set Self = Me
End Property

↓標準モジュール（一行追加）

Enum 列
    本棚番号 = 1
    書籍名称
    著者氏名
End Enum

Public Books As Collection

Sub BookShelfInformation()
    Dim Tb As ListObject
        Set Tb = Sheets("書籍データ").ListObjects("書籍テーブル")
        Set Books = New Collection
    
    Dim i As Long
    For i = 1 To Tb.DataBodyRange.Rows.Count
        With New BookShelfClass
            .本棚番号 = Tb.DataBodyRange.Cells(i, 本棚番号)
            .書籍名称 = Tb.DataBodyRange.Cells(i, 書籍名称)
            .著者氏名 = Tb.DataBodyRange.Cells(i, 著者氏名)
            .通し番号 = i   ' 今回追加した箇所
            
            Books.Add .Self
        End With
    Next
End Sub

さて、追加した通し番号について、今回は少し変則的に使ってみました。本職の方から見れば「邪道」と言われるかも知れません。

↓ユーザーフォーム

Option Explicit

Dim Book As BookShelfClass

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    For Each Book In Books
        If Book.通し番号 = ListBox1.List(ListBox1.ListIndex, 1) Then
            本棚番号Label = Book.本棚番号
            書籍名称Label = Book.書籍名称
            著者氏名Label = Book.著者氏名
            
            Dim Sh As Worksheet
                Set Sh = Sheets("レイアウト図")
                Sh.UsedRange.Interior.Color = xlNone
                Sh.UsedRange.Font.Color = vbBlack
            
            Dim FoundCell As Range
                Set FoundCell = Sh.Cells.Find(What:=Book.本棚番号, LookAt:=xlWhole)
                If Not FoundCell Is Nothing Then
                    FoundCell.Select
                    FoundCell.Interior.Color = 192
                    FoundCell.Font.Color = vbYellow
                End If
            Exit Sub
        End If
    Next
End Sub

Private Sub TextBox1_Change()
    Dim str  As String
        str = TextBox1.Value
        ListBox1.Clear
    Dim seq As Variant
    ReDim seq(1 To Books.Count, 1 To 2)
    Dim i As Long
        i = 1
        For Each Book In Books
            If Book.書籍名称 Like "*" & str & "*" Then
                seq(i, 1) = Book.書籍名称
                seq(i, 2) = Book.通し番号
                i = i + 1
            End If
        Next
        ListBox1.List = seq
End Sub

Private Sub UserForm_Initialize()
    Dim seq As Variant
        Call BookShelfInformation
    ReDim seq(1 To Books.Count, 1 To 2)
    Dim i As Long
        i = 1
        For Each Book In Books
            seq(i, 1) = Book.書籍名称
            seq(i, 2) = Book.通し番号
            i = i + 1
        Next
        ListBox1.List = seq
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

まず、コレクションの一部で配列を作成します。

• 一列目　書籍名称
• 二列目　通し番号（＝キーコード）

この配列で以って、一気にリストボックスのリストを作成します。しかし、ListBox1 にはもともと１列しかありませんので、二列目の通し番号は隠れた状態になります。この「二列目が隠れている状態」が正しい使用方法か分からなかったため、「邪道かも」と書いた次第です。

あとは、今までと同様です。書籍名称を選択した際、その右横に隠れている通し番号を頼りに詳細情報を表示し、正しい書棚を選択することが出来ました。

次回に続く（かもしれない）

備考
同じ題名の本を、何冊も買うことがあるのか？少なくとも、私はありました。かつて、「アトムの子ら」という小説と短編ＳＦ集を買ったときのこと。家に帰って本棚を見ると、同じ装丁の「アトムの子ら」が一冊あったうえに、購入した短編ＳＦの中にも「アトムの子ら」（短編版）がありました。全ては、買っても直ぐに読まず、本棚の肥やしにしている行いの問題だったりします。

参考まで。