67本目：ComboBoxとListBox

出題：ComboBoxとListBox

#VBA100本ノック 67本目
ユーザーフォームのListBoxに、ComboBoxの値で「リスト」シートのA列を絞りこんだデータを表示します。
ListBoxにはB列～D列を列見出しを付けて表示してください。
適宜作業シートを使用。
※オブジェクト名は任意
※コンボは都道府県が設定済としてイベントの作成です。

◇ 出題ページはこちら

ソースコード

Option Explicit

' リスト
Public Const R1stリスト = 2
Public Const C1stリスト = 1
Public Enum CNoリスト
    都道府県 = C1stリスト
    名前
    性別
    誕生日
End Enum
Public Const CLastリスト = CNoリスト.誕生日

' lst個人
Public Const R1stlst個人 = 2
Public Const C1stlst個人 = 1
Public Enum CNolst個人
    名前 = C1stlst個人
    性別
    誕生日
End Enum
Public Const CLastlst個人 = CNolst個人.誕生日

Sub UserForm1を表示する()

    UserForm1.Show vbModeless

End Sub

Option Explicit

' コンボボックスの変更時
Private Sub cmb都道府県_Change()
    
    Dim tgt都道府県 As String: tgt都道府県 = cmb都道府県.Value
    
    ' リストボックス連動シートの更新
    Call リストを都道府県で抽出してlst個人シートへ出力する(tgt都道府県)

    ' リストボックスの更新
    With lst個人
        .ColumnCount = CLastlst個人
        .ColumnWidths = "100;30"
        .ColumnHeads = True
        .RowSource = GetRangeフィルターデータ部分(WSlst個人).Address(External:=True)
    End With

End Sub

' リストボックス連動シートの更新
Sub リストを都道府県で抽出してlst個人シートへ出力する(tgt都道府県 As String)
    
    ' シートのクリア
    Call 指定行より下をすべて削除する(WSlst個人, R1stlst個人)
    
    ' 対象件数の取得
    Dim count対象データ As Long
    count対象データ = Fx.CountIf(WSリスト.Columns(CNoリスト.都道府県), tgt都道府県)
    If count対象データ = 0 Then Exit Sub
    
    ' 出力用の配列を準備
    Dim Arr出力 As Variant
    ReDim Arr出力(1 To count対象データ, 1 To CLastlst個人)
    
    ' リスト全行をループ
    Dim R_リスト As Long
    Dim R_出力 As Long: R_出力 = 1
    For R_リスト = R1stリスト To Get最終行(WSリスト)
        
        ' 対象都道府県のデータを配列へ出力
        If WSリスト.Cells(R_リスト, CNoリスト.都道府県) = tgt都道府県 Then
            
            Arr出力(R_出力, CNolst個人.名前) = WSリスト.Cells(R_リスト, CNoリスト.名前)
            Arr出力(R_出力, CNolst個人.性別) = WSリスト.Cells(R_リスト, CNoリスト.性別)
            Arr出力(R_出力, CNolst個人.誕生日) = WSリスト.Cells(R_リスト, CNoリスト.誕生日)
            R_出力 = R_出力 + 1
            
        End If
        
    Next ' リスト全行をループ

    ' 配列をシートに出力
    Call 二次元配列をセルに出力する(WSlst個人.Cells(R1stlst個人, C1stlst個人), Arr出力)

End Sub

Option Explicit

' WorksheetFunctionの短縮取得
' 参考：https://www.limecode.jp/entry/utility/shortcall-worksheetfunction
Function Fx() As WorksheetFunction
    Set Fx = WorksheetFunction
End Function

' 指定行より下の削除
' 参考：https://www.limecode.jp/entry/utility/delete-rows-below-to-last
Sub 指定行より下をすべて削除する(対象シート As Worksheet, 指定行 As Long)
    With 対象シート
    
        Call フィルターをクリアする(対象シート)
        
        .Range(.Rows(指定行), .Rows(.Rows.Count)).Delete
        
    End With
End Sub

' フィルターのクリア
' ◆ ブログ未掲載
Sub フィルターをクリアする(対象シート As Worksheet)
    If 対象シート.AutoFilterMode = True Then
        If 対象シート.AutoFilter.FilterMode = True Then
            対象シート.AutoFilter.ShowAllData
        End If
    End If
End Sub

' 最終行の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終行(指定オブジェクト As Variant, Optional ByVal C As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終行を取得
    Get最終行 = 対象セル範囲.Rows.Count + 対象セル範囲.Row - 1

    ' 列が指定されていればその列の入力最終行を取得
    If C <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(Get最終行, C) = ""
            Get最終行 = Get最終行 - 1
            If Get最終行 < 対象セル範囲.Row Then
                Get最終行 = 0
                Exit Function
            End If
        Loop
    End If

End Function

' フィルターデータ部
' 参考：https://www.limecode.jp/entry/utility/get-autofilter-datarange
Function GetRangeフィルターデータ部分(指定シート As Worksheet) As Range
    If 指定シート.AutoFilterMode = False Then Exit Function

    Dim フィルターデータ部 As Range
    Set フィルターデータ部 = 指定シート.AutoFilter.Range

    If フィルターデータ部.Rows.Count = 1 Then Exit Function

    Set フィルターデータ部 = フィルターデータ部.Offset(1)
    Set フィルターデータ部 = フィルターデータ部.Resize(フィルターデータ部.Rows.Count - 1)

    Set GetRangeフィルターデータ部分 = フィルターデータ部

End Function

' 二次元配列 → セル
' 参考：https://www.limecode.jp/entry/utility/output-array-to-range
Sub 二次元配列をセルに出力する(出力始点セル As Range, Arr出力配列 As Variant)

    出力始点セル.Resize(Count配列の要素数(Arr出力配列, 1) _
                              , Count配列の要素数(Arr出力配列, 2)).Value = Arr出力配列

End Sub

' 配列の要素数の取得
' 参考：https://www.limecode.jp/entry/syntax/ubound-lbound-count-array-elemens
Function Count配列の要素数(Arr, Optional 次元 = 1) As Long
    Count配列の要素数 = UBound(Arr, 次元) - LBound(Arr, 次元) + 1
End Function

解説

ComboBoxとListBoxを使ったユーザーフォームの問題です。

ListBoxの表示を簡単に実行する方法として、
出力するリストを二次元配列にしてListBox.Listに直接代入する方法があります。

対象ListBox.List = 二次元配列

　
しかしこの方法は「見出し」機能を使うことが出来ないため、
今回の問題のように見出しを使う場合は、出力セル範囲を指定するしかありません。

よって問題文にある通り、作業シートを使用して対応します。

今回は個人名のデータだったため、件数が膨大でもラグが出てしまわないよう、
リストシート⇒作業シートの出力は、今回は配列を使用して高速化しました。

割と単純なコードで記述できますので、転記マクロ高速化の参考にしてみてください。