複数のチェックボックスで、一つだけチェックを入れたい ②

昨日は、１２個のチェックボックスの内、一個だけが選べるようにしてみた。
infoment.hatenablog.com

しかしこの方法だと、チェックボックスが複数のグループに分かれている場合に、とても都合が悪い（グループを無視して、一個しか選べないため）。

そこで今日は、グループを３つに分けたうえで、グループごとに一個だけ選べるよう調整してみる。
f:id:Infoment:20191103082851p:plain

といっても、高度なことは出来ない。チェックボックス名にグループ情報を付し、選別するだけだ。そこでまず、チェックボックスの名前を変更する。名称は以下のとおりとする。

CB_グループ名_通し番号
例）CB_1_1

連続する通し番号をグループ名および通し番号へ変更する場合、以下を用いる。

グループ番号　（通し番号 ÷ グループあたりの人数）を切り上げ
循環通し番号　「（通し番号－１）÷ グループあたりの人数」の余り＋１

予め１引いてから、余りに１を足したのは、循環を１～４とするため。
単純に４で割った余りとした場合、０～３で循環してしまう。
f:id:Infoment:20191103090805p:plain

以上を踏まえ作成した、名称変更用マクロがこちら。

Sub Rename()
    Dim CB As CheckBox
    Dim i As Long: i = 1
    Dim GroupNo As Long
    Dim ItemNo As Long
        With ActiveSheet.CheckBoxes
            For i = 1 To .Count
                ' ４個１セット。
                GroupNo = WorksheetFunction.RoundUp(i / 4, 0)
                ' １～４を循環。
                ItemNo = ((i - 1)) Mod 4 + 1
                ' リネーム。
                .Item(i).Name = "CB_" & GroupNo & "_" & ItemNo
            Next
        End With
End Sub

あとは、昨日の「切り替え」サブルーチンに、グループ選別箇所を追加するだけだ。参考までに、登録用サブルーチンも併せて載せておく。

Sub 登録()
    Dim CB As CheckBox
        For Each CB In ActiveSheet.CheckBoxes
            CB.OnAction = "切り替え"
        Next
End Sub

Sub 切り替え()
    ' 選択したチェックボックス名。
    Dim SelectedCBName As String
    ' 本サブルーチンを呼び出したチェックボックスの名前を格納。
        SelectedCBName = Application.Caller
    
    ' グループ名抽出用配列。
    Dim arr As Variant
        arr = Split(SelectedCBName, "_")
    ' グループ名取得。後ほどLike演算子で評価するために、
    ' "CB_GroupNo_*"とする。
        arr(2) = "*"
    Dim GroupName As String
        GroupName = Join(arr, "_")
    
    ' 選択したチェックボックスと同じグループ名であれば、チェックを外す。
    Dim CB As CheckBox
        For Each CB In ActiveSheet.CheckBoxes
            If CB.Name <> Application.Caller Then
                If CB.Name Like GroupName Then
                    CB.Value = xlOff
                End If
            End If
        Next
End Sub