リストの絞り込み の続き⑦ ~ 登録をコレクションではなく配列に変更 ~
昨日は、複数ある似たようなコードをクラスモジュールで一まとめにすることで、コードのスリム化を図りました。
今回は、各本の登録の仕方を少し変えてみます。
今回のように、本に関する全ての情報を取り込む際、予めリストから本の全冊数を取得することが出来ます。リストの絞り込みでは、都度 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
今回一連のブログ記事では、様々な要件が出てくるたびに、大きく手法を変える場面が幾つもありました。
本来このように場当たり的な開発は、後戻りにより時間のロスが大きく、また修正箇所も多岐にわたるため、是非避けたいところです。
しかし、特に非システムエンジニアの私たちにしてみれば、これを回避する一番の特効薬は「経験」ぐらいしか思いつきません。
そこで今回は、一連のドタバタ劇を「疑似体験」していただくことで、何らかの学習効果があればと考えた次第です。
それでは次回は、今回シリーズの最終回です。
参考まで。