業務効率化

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

ワークシート上に記載された値をチェックボックスとして表示するマクロです。また、チェックする値を別のプロシージャで追加することで表示される際にあらかじめチェックを付けます。これにより配信先を処理するプロシージャでチェックした配信先メアド取得などに応用可能です。

記事の内容

・挙動

・コード

・ポイント機能

挙動

シート上に下記のような値が記載されています。UFではこの列にある値を等間隔でUFに配置していきます。今回は9行目までの8つを工場グループとしてUFに配置しています。

そして、下記で紹介する配列先、配列追加プロシージャの引数に、値を渡すとUFに一致する値がある場合にチェックされます。

下記では第二引数に工場を指定していますが、これはチェック時のループをエクセルの工場が記載されている2行目から9行目のみを走査するように設定しているためです。工場等区分をせずに先頭からループ処理する場合は、今プロシージャの下記部分を削除してください。

コード

➤Sub 配信先検索、配列追加 スクリプト
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
➤チェックボックス表示UFのスクリプト

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

1つ目を標準モジュールとして、2つ目をUFモジュールとして作成してください。その後同じ或いは別のプロシージャから1つ目を呼び、2つ目を表示させてください。

保存時に下記が出る場合は、オプションからファイルを信頼するファイルにするか、標準モジュール類を自分のファイルにインポートしてください。

ポイント機能

・シート上値の動的チェックボックスUF作成

・Sub配信先、配列追加による事前チェック処理

シート上値の動的チェックボックスUF作成

Sub 配信先検索、配列追加(処理対象値 As String, Optional 検索位置 As String)を呼んで、値をCollection型で宣言したPublic変数 のPreCheckValsに処理対象値を入れ、ワークシート上に記載された値と一致する値を格納します。

その後、ワークシート上に記載された値一覧をチェックボックスで表示するUFを呼び出し、PrecheckValsと同じ値があればデフォルトでチェックするように処理しています。

UFに表示されるチェックボックスはシート上のB列に入れます。最後の行までの値を動的に取得し、UFに追加されます。

上記の記載情報から、UFにチェックボックスを配置します。上記の場合、11行目の最終行までがUFに追加されます。

Sub配信先、配列追加による事前チェック処理

UFを表示させると上記がチェックボックスとして表示されますが、あらかじめチェックしたい場合があります。その際にSub 配信先検索、配列追加プロシージャを使います。このプロシージャでは与えた第一引数が、上記のシートB列の中で完全一致すればPrecheckValsに格納し、UF表示した際にチェックを付けさせるというものです。

第一引数にはチェックさせたい対象値、第二引数は今回は検索位置を指定しています。検索位置はなくてもよい引数ですが、今回は東京から新潟までを工場グループと想定し、行であるiを2から9行目までのみを検索対象にしています。これにより工場以外で(9行以降)記載された値にかぶりがあっても回避ができるのと、最下行までのループを防ぐことができます。

例えば、東京をあらかじめチェックしたいとします。下記のように東京と、工場を指定します。

その後、CheckBoxUFを表示されると、UFないでPublic変数の値と一致するものがチェックされます。今回はあらかじめ東京をチェックするようにしたため、東京のチェックボックス追加時にチェックされます。これにより、例えば処理後のメール配信先の追加時、自動化とはい鼻今でも最終確認のみで完了するフローを作成することが可能です。

複数の略称に対する処理

部門においては第一営業部や第一技術部とはいっても、○○サービス課や電子技術部などといった細かい課に分かれている場合や、第1営業部など数値を使うなど略称に多様性がある場合があります。その際の処理としてSub 配信先検索、配列追加プロシージャにおいてはシート上の値に「/」が含まれる場合に追加処理をしています。これにより、シート上の値の過多を避け、動的に引数を与える場合に起こる名称の差にも対応できます。

例えば、11行目の値は/で配列化され、それぞれの値が与えた引数と一致するか比べます。与えた値が、「第一営業部第一課」の場合は一つ目と一致します。これにより、引数に与える値が第一営業部第一課の他に第1営業部第1課のように多少言葉が違っても同じものとして扱いたい名称すべてを同じ略称として扱うことができます。

例えばある申請書から取得した値を動的に引数として渡すとき、人によって記載する名称が異なる場合がありますが、セル上に.存在しうる略称を追加しておくことで柔軟に対応することができます。これはUF上に過剰にチェックボックス表示することも防止できます。

-業務効率化