事前チェックする動的なUFチェックボックス

Option Explicit
Public PreCheckVals As Collection ' 配信先UF用チェックボックス

Sub 配信先検索､配列追加(処理対象値 As String, Optional 検索位置 As String)

If PreCheckVals Is Nothing Then
    Set PreCheckVals = New Collection
End If

Dim plant As String
Dim CompareVals() As String, CompareValsi As Long
Dim i As Long
If 検索位置 = "工場" Then
    i = 2
Else
    i = 10
End If

    Do Until i > ThisWorkbook.Worksheets("配信先一覧").Range("B1000").End(xlUp).Row
     
        If InStr(1, 処理対象値, ThisWorkbook.Worksheets("配信先一覧").Range("B" & i).value, vbTextCompare) > 0 Then
           
            PreCheckVals.Add ThisWorkbook.Worksheets("配信先一覧").Range("B" & i).value
            Exit Do
        ElseIf InStr(1, ThisWorkbook.Worksheets("配信先一覧").Range("B" & i).value, "/", vbTextCompare) > 0 Then
            CompareVals = Split(ThisWorkbook.Worksheets("配信先一覧").Range("B" & i).value, "/")
            For CompareValsi = LBound(CompareVals) To UBound(CompareVals)
                If InStr(1, 処理対象値, CompareVals(CompareValsi), vbTextCompare) > 0 Then
                    PreCheckVals.Add ThisWorkbook.Worksheets("配信先一覧").Range("B" & i).value
                    Exit Do
                End If
            Next
        End If
        
        If 検索位置 = "工場" And i = 10 Then
            Exit Do
        End If
        i = i + 1
    Loop
    

End Sub

Option Explicit
Private CheckBoxes() As MSForms.CheckBox
'Private CommandBTNOK As MSForms.Commandbutton
Public checkedList As Collection
Dim WithEvents CommandBTNOK As MSForms.Commandbutton

Private Sub CommandBTNOK_Click()
    
    Dim i As Long
    Set checkedList = New Collection

    For i = LBound(CheckBoxes) To UBound(CheckBoxes)
        If Not CheckBoxes(i) Is Nothing Then
            If CheckBoxes(i).value = True Then
                checkedList.Add CheckBoxes(i).Caption
            End If
        End If
    Next i

    ' 取得したチェック項目を表示（例）
    Dim msg As String
    Dim item As Variant
    For Each item In checkedList
        msg = msg & item & vbCrLf
    Next item

    'MsgBox checkedList(1)
    
    Me.Hide

End Sub

Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    Dim lastrow As Long
    Dim i As Long
    Dim colWidth As Long, rowHeight As Long
    Dim factoryFrame As MSForms.Frame
    Dim cbIndex As Long
    Dim xPos As Long, yPos As Long

    ' ? あらかじめチェックしておきたい項目
'Dim PreCheckedValues As New Collection


    Set ws = ThisWorkbook.Sheets("配信先一覧")
    lastrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ReDim CheckBoxes(1 To lastrow - 1)

    colWidth = 100
    rowHeight = 20

    ' 工場フレーム作成
    Set factoryFrame = Me.Controls.Add("Forms.Frame.1", "FactoryFrame", True)
    With factoryFrame
        .Caption = "工場"
        .Left = 10
        .Top = 10
        .Width = colWidth * 2
        .Height = rowHeight * 4 + 30
    End With

    ' 最初の8個をフレーム内に2列で配置
    For i = 1 To 8
        If ws.Cells(i + 1, "B").value <> "" Then
            Set CheckBoxes(i) = factoryFrame.Controls.Add("Forms.CheckBox.1", "CheckBox" & i, True)
            With CheckBoxes(i)
                .Caption = ws.Cells(i + 1, "B").value
                .Width = colWidth - 10
                xPos = 5 + ((i - 1) Mod 2) * colWidth
                yPos = 13 + ((i - 1) \ 2) * rowHeight
                .Left = xPos
                .Top = yPos
                ' ? キャプションが一致していたらチェック
                If IsInCollection(.Caption, PreCheckVals) Then .value = True
            End With
        End If
    Next i

    ' 9個目以降をフォームに直接配置（2列）
    For i = 9 To lastrow - 1
        If ws.Cells(i + 1, "B").value <> "" Then
            Set CheckBoxes(i) = Me.Controls.Add("Forms.CheckBox.1", "CheckBox" & i, True)
            With CheckBoxes(i)
                .Caption = ws.Cells(i + 1, "B").value
                .Width = 100 + Len(.Caption) * 5
                xPos = 10 + ((i - 9) Mod 2) * colWidth
                yPos = factoryFrame.Top + factoryFrame.Height + 10 + ((i - 9) \ 2) * rowHeight
                .Left = xPos
                .Top = yPos
                ' ? キャプションが一致していたらチェック
                If IsInCollection(.Caption, PreCheckVals) Then .value = True
            End With
        End If
    Next i

    Me.ScrollBars = fmScrollBarsVertical
    Me.ScrollHeight = factoryFrame.Top + factoryFrame.Height + ((lastrow - 9) \ 2 + 1) * rowHeight + 50
    Me.Height = yPos + 70

    Set CommandBTNOK = Me.Controls.Add("Forms.CommandButton.1", "CommandBTNOK", True)
    With CommandBTNOK
        .Caption = "OK"
        .Top = yPos + 20
        .Left = Me.Width / 3
        .Width = 50
        .Height = 20
    End With
End Sub


Private Function IsInCollection(valToBeFound As String, col As Collection) As Boolean
    Dim item As Variant
    For Each item In col
        If item = valToBeFound Then
            IsInCollection = True
            Exit Function
        End If
    Next item
    IsInCollection = False
End Function


' チェックされた値を取得する例
Public Function GetCheckedValues() As Collection
    Dim checkedValues As New Collection
    Dim i As Long

    For i = LBound(CheckBoxes) To UBound(CheckBoxes)
        If Not CheckBoxes(i) Is Nothing Then
            If CheckBoxes(i).value = True Then
                checkedValues.Add CheckBoxes(i).Caption
            End If
        End If
    Next i

    Set GetCheckedValues = checkedValues
End Function