リストの絞り込み　の続き⑦　～ 登録をコレクションではなく配列に変更 ～

Excel VBA クラスモジュール

昨日は、複数ある似たようなコードをクラスモジュールで一まとめにすることで、コードのスリム化を図りました。

infoment.hatenablog.com

今回は、各本の登録の仕方を少し変えてみます。

今回のように、本に関する全ての情報を取り込む際、予めリストから本の全冊数を取得することが出来ます。リストの絞り込みでは、都度 For ～ Next ループで虱潰しに探す手法をとっていましたが、配列にすればインデックスを指定して直接情報を取得することも可能です。

そこで上記を試みて、次の結果となりました。
［減ったもの］

  • Book
  • Self
  • 幾つかの For ～ Next ループ

［増えたもの］

  • 変数 iMax
  • 変数 j

最終的なコードは、以下の通りです。

↓ BookShelfClass

Option Explicit

Public 本棚番号 As String
Public 書籍名称 As String
Public 著者氏名 As String
Public 通し番号 As Long

↓ ListBoxControlClass

Option Explicit

Private WithEvents myListBox As MSForms.ListBox
Private myIndex As Long

Public Sub Set_ListBox(newListBox As MSForms.ListBox, Index As Long)
    Set myListBox = newListBox
    myIndex = Index
End Sub

Private Sub myListbox_Click()
    With BookShelfForm
        Dim BookIndex As Long
            BookIndex = myListBox.List(myListBox.ListIndex, 1)
            .本棚番号Label = Books(BookIndex).本棚番号
            .書籍名称Label = Books(BookIndex).書籍名称
            .著者氏名Label = Books(BookIndex).著者氏名

        Dim Sh As Worksheet
            Set Sh = Sheets("レイアウト図")

        Dim FoundCell As Range
            Set FoundCell = Sh.Cells.Find(What:=Books(BookIndex).本棚番号, LookAt:=xlWhole)
            If Not FoundCell Is Nothing Then
                ChangeColor Sh, FoundCell
            End If
            
            If myIndex = 2 Then
                .TextBox1.Value = ""
                .ListBox1.Clear
            End If
        Exit Sub
    End With
End Sub

↓ 標準モジュール

Option Explicit

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

Public Books() As BookShelfClass
Public BookShelfListBox(1 To 2) As ListBoxControlClass

Sub BookShelfInformation()
    Dim Tb As ListObject
        Set Tb = Sheets("書籍データ").ListObjects("書籍テーブル")
    
    Dim iMax As Long
        iMax = Tb.DataBodyRange.Rows.Count
        ReDim Books(1 To iMax)
        
    Dim i As Long
    For i = 1 To iMax
        Set Books(i) = New BookShelfClass
        With Books(i)
            .本棚番号 = Tb.DataBodyRange.Cells(i, 本棚番号)
            .書籍名称 = Tb.DataBodyRange.Cells(i, 書籍名称)
            .著者氏名 = Tb.DataBodyRange.Cells(i, 著者氏名)
            .通し番号 = i
        End With
    Next
End Sub
Public Function ChangeColor(target_sheet As Worksheet, _
                            target_range As Range) _
                            As Boolean
    On Error GoTo er:
    ' シートの色をリセット
    target_sheet.UsedRange.Interior.Color = xlNone
    target_sheet.UsedRange.Font.Color = vbBlack

    ' 指定セルの色を変更
    With target_range
        .Select
        .Interior.Color = 192
        .Font.Color = vbYellow
    End With
    ChangeColor = True
    Exit Function
er:
    ChangeColor = False
End Function

Public Sub InitUserform()
    Dim tempSeq As Variant
        Call BookShelfInformation
    ReDim tempSeq(1 To UBound(Books), 1 To 2)
    Dim i As Long
    Dim j As Long
        j = 1
        For i = 1 To UBound(Books)
            If Selection.Value = Books(i).本棚番号 Then
                tempSeq(j, 1) = Books(i).書籍名称
                tempSeq(j, 2) = Books(i).通し番号
                j = j + 1
            End If
        Next
    Dim seq As Variant
    ReDim seq(1 To j - 1, 1 To 2)
        For i = 1 To UBound(seq)
            seq(i, 1) = tempSeq(i, 1)
            seq(i, 2) = tempSeq(i, 2)
        Next
        BookShelfForm.ListBox2.List = seq
End Sub

Sub SetBookShelfListBox()
    Dim i As Long
        For i = 1 To 2
            Set BookShelfListBox(i) = New ListBoxControlClass
            BookShelfListBox(i).Set_ListBox BookShelfForm.Controls("ListBox" & i), i
        Next
End Sub

↓ BooShelfForm

Option Explicit

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

Private Sub UserForm_Initialize()
    Call InitUserform
    Call SetBookShelfListBox
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

今回一連のブログ記事では、様々な要件が出てくるたびに、大きく手法を変える場面が幾つもありました。
本来このように場当たり的な開発は、後戻りにより時間のロスが大きく、また修正箇所も多岐にわたるため、是非避けたいところです。
しかし、特に非システムエンジニアの私たちにしてみれば、これを回避する一番の特効薬は「経験」ぐらいしか思いつきません。
そこで今回は、一連のドタバタ劇を「疑似体験」していただくことで、何らかの学習効果があればと考えた次第です。

それでは次回は、今回シリーズの最終回です。

参考まで。