『トグルのグループ分けと入力』（はせぴぃ）

ユーザフォームにてテキストボックスを2個、トグルボタンを15程度作成し、
テキストボックスへは時間を挿入(3桁or4桁の数字を時間へ変換)、
トグルボタンはONの際、ボタン名を取得、
不規則にトグルボタンをグループ分けする
Ａ：Toggle1、Toggle2、Toggle3、Toggle7、…
Ｂ：Toggle4、Toggle6、Toggle9、…
Ｃ：Toggle5、Toggle8、…
Ｄ：Toggle10、…

コマンドボタンを押したら
別のブック(当年の西暦年のブック名：2021年.xls)、当月のシート(8月)の
A2セルへコマンドボタンを押したときの年/月/日
B2セルへテキストボックス1の時間入力
C2セルへテキストボックス2の時間入力
(テキストボックス2が空白の場合はコマンドボタンを押した時間)
D2セルへ時間の計算式(C2-B2)
E2セルへは"A"、"B+C"、"A+C+D"などトグルボタンのONのグループを入力
F2セル以降(右へ)　トグルボタンのONのもののみボタン名を入力(詰めて)

以降、コマンドボタンを押すたび下行へ入力をしていく

この様なVBAを作成できるでしょうか？




＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
----
 ここの部分はトグルのグループ分けに関係ないので、そちらでコードを書いてアップしてください。
   ↓
 ＞コマンドボタンを押したら
 ＞別のブック(当年の西暦年のブック名：2021年.xls)、当月のシート(8月)の
 ＞A2セルへコマンドボタンを押したときの年/月/日
 ＞B2セルへテキストボックス1の時間入力
 ＞C2セルへテキストボックス2の時間入力
 ＞(テキストボックス2が空白の場合はコマンドボタンを押した時間)
 ＞D2セルへ時間の計算式(C2-B2)

（半平太） 2021/08/22(日) 14:14
----
 当方、初心者にて
全体的にもいまいちです。

お手数ですが、整合性を取るためにも
作成して頂けないでしょうか？
（はせぴぃ） 2021/08/25(水) 13:02
----
 業務委託でしたら最初にその旨を書き、また、
 出せる業務委託料の概算を提示しましょう。
（通りすがり） 2021/08/25(水) 13:12
----
 'モジュール変数
 Dim wb As Workbook          '書き込み先ブック
 Dim sh As Worksheet         '書き込み先シート
 Dim flg As Boolean          'フラグ（トグルの誤作動防止用）
 Dim rowIdx As Long          '書き込み先の行
 Dim GroupName() As Variant  'トグルボタンのグループ名

 Private Sub UserForm_Initialize()
 'フォームを開くときの動作
    Dim filePath As String
    Dim fileName As String
    Dim ctl As Control
    
    filePath = ThisWorkbook.Path & "\"                  '書き込み先ブックのフォルダパス（※仮にこのマクロを書いたブックと同一フォルダにしてある）
    fileName = Dir(filePath & Year(Date) & "年.xls?")   '書き込み先ブックのファイル名
    Set wb = Workbooks.Open(filePath & fileName)        'ブックを開く
    Set sh = wb.Worksheets(Month(Date) & "月")          '書き込み先シートを設定する
    rowIdx = 2                                          '書き込み先頭行を設定
    GroupName = Array("A", "B", "C", "D")               'グループ名を設定
    
    Randomize                                           '乱数設定
    For Each ctl In Me.Controls                         'フォーム上のコントロールを巡回
        If TypeName(ctl) = "ToggleButton" Then          'トグルボタンかどうか調べる
            ctl.Tag = GroupName(Int(Rnd() * 4))         'Tagプロパティにランダムにグループ名のいずれかを入力
        End If
    Next
 End Sub

 Private Sub UserForm_Terminate()
 'フォームを閉じるときの動作
    wb.Close    '書き込み先ブックを閉じる（データ更新されていた場合は保存ダイアログが出る）
 End Sub

 Private Sub TglFunction(Tgl As MSForms.ToggleButton)
 'トグルボタン押下時の動作
    Dim ctl As Control
    flg = True  '再帰動作抑制のためにフラグを立てる
    For Each ctl In Me.Controls
        If TypeName(ctl) = "ToggleButton" Then
            'タグに設定した値が同じ（同一グループ）で押したトグルボタン自身でないものは値をFalseにする
            If ctl.Tag = Tgl.Tag And Not ctl Is Tgl Then ctl.Value = False
        End If
    Next
    flg = False '動作抑制解除のためにフラグを下す
 End Sub

 '個々のトグルボタン押下時に起動するプロシージャ
 'わかりやすさ重視でクラスモジュールは使用しない
 Private Sub ToggleButton1_Click()
    'フラグがFalseのときTglFunctionを起こす
    '（TglFunction動作中に再帰的に動作してエラーを起こすのでflg設定がしてある）
    If Not flg Then Call TglFunction(ToggleButton1)
 End Sub
 Private Sub ToggleButton2_Click()
    If Not flg Then Call TglFunction(ToggleButton2)
 End Sub
 Private Sub ToggleButton3_Click()
    If Not flg Then Call TglFunction(ToggleButton3)
 End Sub
 Private Sub ToggleButton4_Click()
    If Not flg Then Call TglFunction(ToggleButton4)
 End Sub
 Private Sub ToggleButton5_Click()
    If Not flg Then Call TglFunction(ToggleButton5)
 End Sub
 Private Sub ToggleButton6_Click()
    If Not flg Then Call TglFunction(ToggleButton6)
 End Sub
 Private Sub ToggleButton7_Click()
    If Not flg Then Call TglFunction(ToggleButton7)
 End Sub
 Private Sub ToggleButton8_Click()
    If Not flg Then Call TglFunction(ToggleButton8)
 End Sub
 Private Sub ToggleButton9_Click()
    If Not flg Then Call TglFunction(ToggleButton9)
 End Sub
 Private Sub ToggleButton10_Click()
    If Not flg Then Call TglFunction(ToggleButton10)
 End Sub
 Private Sub ToggleButton11_Click()
    If Not flg Then Call TglFunction(ToggleButton11)
 End Sub
 Private Sub ToggleButton12_Click()
    If Not flg Then Call TglFunction(ToggleButton12)
 End Sub
 Private Sub ToggleButton13_Click()
    If Not flg Then Call TglFunction(ToggleButton13)
 End Sub
 Private Sub ToggleButton14_Click()
    If Not flg Then Call TglFunction(ToggleButton14)
 End Sub
 Private Sub ToggleButton15_Click()
    If Not flg Then Call TglFunction(ToggleButton15)
 End Sub

 Private Sub CommandButton1_Click()
'コマンドボタン押下時の操作
    Dim TB1Val As Variant
    Dim TB2Val As Variant
    Dim TB2minusTB1 As Variant
    Dim OnGroups As String
    Dim OnToggles As String
    Dim ctl As Control
    Dim bool() As Boolean
    Dim i As Long
    
    'B列に入れる値を設定（テキストボックス1の値を入れる）
    TB1Val = Me.TextBox1.Text
    
    'C列に入れる値を設定（テキストボックス2が空白の場合とそうでない場合の分岐）
    If Me.TextBox2.Value <> "" Then
        TB2Val = Me.TextBox2.Text
    Else
        TB2Val = Date
    End If
    
    'D列に入れる値を設定（C列の値からB列の値を引く）
    TB2minusTB1 = CDbl(TB2Val) - CDbl(TB1Val)
    
    'E列F列に入れる値を設定（トグルボタンを巡回して値を取得）
    ReDim bool(LBound(GroupName) To UBound(GroupName))
    For Each ctl In Me.Controls
        If TypeName(ctl) = "ToggleButton" Then
            If ctl.Value Then
                OnToggles = OnToggles & ctl.Caption
                For i = LBound(GroupName) To UBound(GroupName)
                    If ctl.Tag = GroupName(i) Then bool(i) = True
                Next
            End If
        End If
    Next
    For i = LBound(bool) To UBound(bool)
        If bool(i) Then
            If OnGroups = "" Then
                OnGroups = GroupName(i)
            Else
                OnGroups = OnGroups & "+" & GroupName(i)
            End If
        End If
    Next
    
    'A〜F列に値を入力
    sh.Cells(rowIdx, 1).Value = Date
    sh.Cells(rowIdx, 2).Value = TB1Val
    sh.Cells(rowIdx, 3).Value = TB2Val
    sh.Cells(rowIdx, 4).Value = TB2minusTB1
    sh.Cells(rowIdx, 5).Value = OnGroups
    sh.Cells(rowIdx, 6).Value = OnToggles
    '入力行の設定を1増加させる
    rowIdx = rowIdx + 1

 End Sub

試作品です
期待どおりの動きではないかもしれませんがそのときはごめんなさい
（めざめるパワー） 2021/08/25(水) 17:01
----
 めざめるパワーさん、細かくありがとうございます♪

 当方、初心者でありVBA習得中なので
参考にさせて頂き、
ゆっくり作成させてもらいます。

 少し時間かかるかもしれませんが、
その時はフォローお願いしますm(_ _)m

（はせぴぃ） 2021/08/27(金) 09:43
----
 先のVBA、確認してますが
うまくいきません。
 当方の伝え方がまずかったでしょうか？

 まず、トルグボタンを選択すると、
2-3個目で以前のものが解除されてしまいます。
 選択したものは全て反映させたいです。

 また、トルグボタンのグループ分けは
不規則ではありますが、
必ず特定されたグループに分けたいです。

 自分の作り方が間違っているのでしょうか？

（はせぴぃ） 2021/08/31(火) 08:59
----
おはようございます。
上記のコードは「不規則なグループ分け」をランダムなグループ分けと解釈しているので
フォームを立ち上げるごとにグループが変わります。
そして同一グループ内の別のボタンが押下されるとそのトグルボタンは選択解除されます。
そのため2-3個目で以前のものが解除されることがあります。

こちらが「不規則なグループ分け」のルールについての解釈を間違えていたのでこうなっています。
どのように分けるのが正しいのか教えてください。
「不規則だが必ず特定されたグループ」というものの例を教えてください。
（めざめるパワー） 2021/08/31(火) 09:27
----
 早速のご回答、ありがとうございます

トルグボタンは同グループ、別グループ共
複数選択の時もあります。

 グループ分けは
Ａ：Toggle1、Toggle2、Toggle3、Toggle7、Toggle11
Ｂ：Toggle4、Toggle6、Toggle9、Toggle12、Toggle15
Ｃ：Toggle5、Toggle8、Toggle13、Toggle14
Ｄ：Toggle10

となります。

質問が判りづらくてすいませんでした

（はせぴぃ） 2021/08/31(火) 10:50
----
 'モジュール変数
 Dim dic As Object      'トグルボタン構成を収めるDictionaryオブジェクト
 Dim wb As Workbook     '書き込み先ブック
 Dim sh As Worksheet    '書き込み先シート
 Dim rowIdx As Long     '書き込み先の行
 Dim GroupName() As Variant

 Private Sub UserForm_Initialize()
 'フォームを開くときの動作
    Dim Member() As Variant
    Dim filePath As String
    Dim fileName As String
    Dim tmp As Variant
    Dim ctl As MSforms.ToggleButton
    Dim i As Long, j As Long
    
    Set dic = CreateObject("Scripting.Dictionary")
    filePath = ThisWorkbook.Path & "\"                  '書き込み先ブックのフォルダパス（※仮にこのマクロを書いたブックと同一フォルダにしてある）
    fileName = Dir(filePath & Year(Date) & "年.xls?")   '書き込み先ブックのファイル名
    Set wb = Workbooks.Open(filePath & fileName)        'ブックを開く
    Set sh = wb.Worksheets(Month(Date) & "月")          '書き込み先シートを設定する
    rowIdx = 2                                          '書き込み先頭行を設定
    GroupName = Array("A", "B", "C", "D")               'グループ名を設定
    Member = Array("1 2 3 7 11", "4 6 9 12 15", "5 8 13 14", "10")  'グループ構成を設定
    
    For i = LBound(GroupName) To UBound(GroupName)
        dic.Add GroupName(i), CreateObject("Scripting.Dictionary")
        tmp = Split(Member(i))
        For j = LBound(tmp) To UBound(tmp)
            Set ctl = Me.Controls("ToggleButton" & tmp(j))
            dic(GroupName(i)).Add ctl.Caption, ctl
        Next
    Next
 End Sub

 Private Sub UserForm_Terminate()
 'フォームを閉じるときの動作
    wb.Close    '書き込み先ブックを閉じる（データ更新されていた場合は保存ダイアログが出る）
 End Sub

 Private Sub CommandButton1_Click()
 'コマンドボタン押下時の操作
    Dim TB1Val As Variant
    Dim TB2Val As Variant
    Dim TB2minusTB1 As Variant
    Dim OnGroups As String
    Dim OnToggles As String
    Dim ctl As Variant
    Dim i As Long
    
    'B列に入れる値を設定（テキストボックス1の値を入れる）
    If Me.TextBox1.Value <> "" Then
        TB1Val = Me.TextBox1.Text
    Else
        MsgBox "TextBox1 Empty"
        Exit Sub
    End If
    'C列に入れる値を設定（テキストボックス2が空白の場合とそうでない場合の分岐）
    If Me.TextBox2.Value <> "" Then
        TB2Val = Me.TextBox2.Text
    Else
        TB2Val = Date
    End If
    
    'D列に入れる値を設定（C列の値からB列の値を引く）
    TB2minusTB1 = CDbl(TB2Val) - CDbl(TB1Val)
    'E列F列に入れる値を設定（トグルボタンを巡回して値を取得）
    For Each ctl In Me.Controls
        If TypeName(ctl) = "ToggleButton" Then
            If ctl.Value Then
                OnToggles = OnToggles & ctl.Caption
            End If
        End If
    Next
    For i = LBound(GroupName) To UBound(GroupName)
        For Each ctl In dic(GroupName(i)).items
            If ctl.Value Then
                If OnGroups = "" Then
                    OnGroups = GroupName(i)
                Else
                    OnGroups = OnGroups & "+" & GroupName(i)
                End If
                Exit For
            End If
        Next
    Next
    
    'A〜F列に値を入力
    sh.Cells(rowIdx, 1).Value = Date
    sh.Cells(rowIdx, 2).Value = TB1Val
    sh.Cells(rowIdx, 3).Value = TB2Val
    sh.Cells(rowIdx, 4).Value = TB2minusTB1
    sh.Cells(rowIdx, 5).Value = OnGroups
    sh.Cells(rowIdx, 6).Value = OnToggles
    '入力行の設定を1増加させる
    rowIdx = rowIdx + 1

 End Sub

試作２号です。
グループ設定はInitializeの中にあるGroupNameとMemberでしてあります。
（めざめるパワー） 2021/09/02(木) 09:26
----
 早々の改訂ありがとうございます

 Textbox1、2は3桁or4桁の数字を入力し
コマンドボタンを押すと別のブックへは時間に変換
　900 → 9:00　　1500 → 15:00
と入力したいです
よって、B、C、Dは時間hh:mm表記にしたいです

 Textbox2空白時、C列に今日の日付が入ってしまいます

また、Toggleボタン名のF、G列、…への入力は名称を
1名称1セルでお願いいたします
1、2、4、10…と選択したら
F2：Toggle1、G2：TOGGLE2、H2：Toggle4、G2：Toggle10…
として頂きたいです

 入力後、保存をし、保存先ブックを閉じ
再施行(フォームからコマンドボタンを入で力)すると
上書き(セル2行目から)されてしまいます
積み上げて下行の空白列に入力できるようにしていただきたいです

 あと、保存先ブックはコマンドボタンを押したらブックを開いて
入力、保存し閉じる(ブックを開かない使用は無理ですよね…)
その後、メッセージボックスで『保存完了』
(OKボタンでウィンドウ閉じる)の様な仕様もお願いできませんでしょうか

 注文が多くてすいませんがお願いできますでしょうか？

（はせぴぃ） 2021/09/03(金) 07:23
----
 'モジュール変数
 Dim dic As Object          'トグルボタン構成を収めるDictionaryオブジェクト
 Dim GroupName() As Variant 'トグルボタンのグループ名

 Private Sub UserForm_Initialize()
 'フォームを開くときの動作
    Dim Member() As Variant
    Dim tmp As Variant
    Dim ctl As MSForms.ToggleButton
    Dim i As Long, j As Long
    
    Set dic = CreateObject("Scripting.Dictionary")
    GroupName = Array("A", "B", "C", "D")                           'グループ名を設定
    Member = Array("1 2 3 7 11", "4 6 9 12 15", "5 8 13 14", "10")  'グループ構成を設定
    
    For i = LBound(GroupName) To UBound(GroupName)
        dic.Add GroupName(i), CreateObject("Scripting.Dictionary")
        tmp = Split(Member(i))
        For j = LBound(tmp) To UBound(tmp)
            Set ctl = Me.Controls("ToggleButton" & tmp(j))
            dic(GroupName(i)).Add ctl.Caption, ctl
        Next
    Next
 End Sub

 Private Sub CommandButton1_Click()
 'コマンドボタン押下時の操作
    Dim wb As Workbook     '書き込み先ブック
    Dim sh As Worksheet    '書き込み先シート
    Dim filePath As String
    Dim fileName As String
    
    Dim TB1Val As Variant
    Dim TB2Val As Variant
    Dim TB2minusTB1 As Variant
    Dim OnGroups As String
    Dim OnToggles As Variant
    Dim ctl As Variant
    Dim rowIdx As Long     '書き込み先の行
    Dim i As Long
    
    'B列に入れる値を設定（テキストボックス1の値を入れる）
    If TimeStrTest(Me.TextBox1.Value) Then
        TB1Val = AddColon(Me.TextBox1.Value)
    Else
        MsgBox "Invalid Value for TextBox1", vbInformation
        Exit Sub
    End If
    'C列に入れる値を設定（テキストボックス2が空白の場合とそうでない場合の分岐）
    If TimeStrTest(Me.TextBox2.Value) Then
        TB2Val = AddColon(Me.TextBox2.Value)
    Else
        TB2Val = Format(Now - Date, "h:mm")
    End If
    
    'D列に入れる値を設定（C列の値からB列の値を引く）
    TB2minusTB1 = Format(TimeValue(TB2Val) - TimeValue(TB1Val), "h:mm")
    'E列F列に入れる値を設定（トグルボタンを巡回して値を取得）
    For Each ctl In Me.Controls
        If TypeName(ctl) = "ToggleButton" Then
            If ctl.Value Then
                OnToggles = OnToggles & ctl.Caption & " "
            End If
        End If
    Next
    If OnToggles <> "" Then
        OnToggles = Split(OnToggles)
    End If
    
    For i = LBound(GroupName) To UBound(GroupName)
        For Each ctl In dic(GroupName(i)).items
            If ctl.Value Then
                If OnGroups = "" Then
                    OnGroups = GroupName(i)
                Else
                    OnGroups = OnGroups & "+" & GroupName(i)
                End If
                Exit For
            End If
        Next
    Next
    
    '書き込み先ブックを開く
    filePath = ThisWorkbook.Path & "\"
    fileName = Dir(filePath & Year(Date) & "年.xls?")
    Set wb = Workbooks.Open(filePath & fileName)
    Set sh = wb.Worksheets(Month(Date) & "月")
    '書き込み先頭行を設定
    rowIdx = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'A〜F列に値を入力
    sh.Cells(rowIdx, 1).Value = Date
    sh.Cells(rowIdx, 2).Value = TB1Val
    sh.Cells(rowIdx, 3).Value = TB2Val
    sh.Cells(rowIdx, 4).Value = TB2minusTB1
    sh.Cells(rowIdx, 5).Value = OnGroups
    On Error Resume Next
    sh.Cells(rowIdx, 6).Resize(, UBound(OnToggles) + 1).Value = OnToggles
    On Error GoTo 0
    
    sh.Cells(rowIdx, 2).Resize(, 3).NumberFormatLocal = "hh:mm"
    
    wb.Close Savechanges:=True      '書き込み先ブックを保存し閉じる
    
    MsgBox "保存完了"

 End Sub

 Private Function TimeStrTest(ByVal Arg As String) As Boolean
    Dim PatternStr As String
    PatternStr = "^([0-9]|[01][0-9]|2[0-3])[0-5][0-9]$"
    With CreateObject("VBScript.RegExp")
        .Pattern = PatternStr
        TimeStrTest = .test(Arg)
    End With
 End Function

 Private Function AddColon(Arg As String) As String
    AddColon = Left(Arg, Len(Arg) - 2) & ":" & Right(Arg, 2)
 End Function

試作３号です。
いまひとつな出来なのでまた直すかもしれません。

（めざめるパワー） 2021/09/07(火) 13:18
----
 毎回、早い試作ありがとうございます

 今回でかなり理想に近づきました

 保存終了したら、テキストボックス、トルグボタンは
リセット(空白、ボタンoff)になって次の入力も
すぐできるようになっていてほしいです

 今さらかと知れませんが、ブックを『年』ではなく『年度』に
できますか？
 ブック名、シート名は大きくこだわりません

 トルグボタンにプラスしてコンボボックスも
グループに含めることはできますか？
(Toggle1の前に2つ、Toggle15の後に3つ)
両者共、『年度』Bookの別sheet(sheet1)のセルから選択
(例：B2:B10、B21:B30、B51:B60、B66:70、B71:B80)
可能なら『名前』で(い、ろ、は、に、ほ)
Toggle1の前のものはグループは決め打ち
(Cに入力B2=A、B3=C、B4=B、…等)
Toggle15の後のものはセル選択は前者と同様、
グループ分けはオプションボタンを作成して
グループを選択するような形はとれますか？
(駄目なら全部前者の形でもいいです)

 毎度、注文ばかりで申し訳ありませんが対応していただけますでしょうか？


（はせぴぃ） 2021/09/10(金) 20:38
----
 'モジュール変数
 Dim CmbBoxes1() As MSForms.ComboBox     '先頭側コンボボックスのリスト
 Dim CmbBoxes2() As MSForms.ComboBox     '末尾側コンボボックスのリスト
 
 Dim GroupName() As Variant     'トグルボタンのグループ名
 Dim ListAddress As Variant     'コンボボックスのリストの参照セル
 Dim CmbBoxGroup() As Variant   'コンボボックスのインデックスごとのグループ名
 Dim filePath As String
 Dim fileName As String


 Private Sub UserForm_Initialize()
 'フォームを開くときの動作
    Dim Member() As Variant
    Dim tmp As Variant
    Dim ctl As MSForms.ToggleButton
    Dim i As Long
    Dim j As Long
        
    filePath = ThisWorkbook.Path & "\"                                  '書き込み先及びコンボボックスリストのあるフォルダ名
    fileName = Dir(filePath & Year(Date) & "年度.xls?")                 '書き込み先及びコンボボックスリストのあるファイル名
    
    GroupName = Array("A", "B", "C", "D")                               'グループ名を設定
    Member = Array("1 2 3 7 11", "4 6 9 12 15", "5 8 13 14", "10")      'トグルボタンのグループ構成を設定
    
    ListAddress = Array("い", "ろ", "は", "に", "ほ")                   'コンボボックスリスト用の参照先アドレス設定（※範囲名定義済の前提）
    'ListAddress = Array("B2:B10", "B21:B30", "B51:B60", "B66:B70", "B71:B80")  '範囲名未定義の場合の参照先アドレス
    
    ReDim CmbBoxes1(1)                                                  '先頭側コンボボックスリストにコントロールを設定
    Set CmbBoxes1(0) = Me.ComboBox1
    Set CmbBoxes1(1) = Me.ComboBox2
    ReDim CmbBoxes2(2)                                                  '末尾側コンボボックスリストにコントロールを設定
    Set CmbBoxes2(0) = Me.ComboBox3
    Set CmbBoxes2(1) = Me.ComboBox4
    Set CmbBoxes2(2) = Me.ComboBox5
    
    
    For i = LBound(GroupName) To UBound(GroupName)                      'トグルボタンのグループ設定
        tmp = Split(Member(i))
        For j = LBound(tmp) To UBound(tmp)
            Me.Controls("ToggleButton" & tmp(j)).Tag = GroupName(i)
        Next
        For j = 0 To 2                                                  '末尾側コンボボックス用のオプションボタン設定（コンボボックス3個に4個ずつ＝12個）
            With Me.Controls("OptionButton" & j * 4 + i + 1)
                .Caption = GroupName(i)
                .GroupName = "Group" & j + 1
            End With
        Next
    Next
    
    ReDim CmbBoxGroup(LBound(ListAddress) To UBound(ListAddress))       'コンボボックスのリスト、グループを構成（グループは選択アイテムのインデックスごと）
    With Workbooks.Open(filePath & fileName)
            For i = LBound(ListAddress) To UBound(ListAddress)
                With .Worksheets("sheet1").Range(ListAddress(i))
                    Me.Controls("ComboBox" & i + 1).List = .Value       '参照先列の値をコンボボックスのリストに登録
                    CmbBoxGroup(i) = .Offset(, 1).Value                 '参照先右隣列の値をグループ名とする
                End With
            Next
        .Close Savechanges:=False
    End With
 End Sub

 Private Sub CommandButton1_Click()
 'コマンドボタン押下時の操作
    
    Const DLM As String = " "
    
    Dim wb As Workbook          '書き込み先ブック
    Dim sh As Worksheet         '書き込み先シート
    
    Dim TB1Val      As Variant
    Dim TB2Val      As Variant
    Dim TB2minusTB1 As Variant
    Dim OnGroups    As String
    Dim tmpGroups   As Variant
    Dim OnControls  As Variant
    Dim rowIdx      As Long     '書き込み先の行
    Dim ctl As Control
    Dim i As Long
    Dim j As Long
    
    'B列に入れる値を設定（テキストボックス1の値を入れる）
    If TimeStrTest(Me.TextBox1.Value) Then
        TB1Val = AddColon(Me.TextBox1.Value)
    Else
        MsgBox "Invalid Value for TextBox1", vbInformation
        Exit Sub
    End If
    
    'C列に入れる値を設定（テキストボックス2が空白の場合とそうでない場合の分岐）
    If TimeStrTest(Me.TextBox2.Value) Then
        TB2Val = AddColon(Me.TextBox2.Value)
    Else
        TB2Val = Format(Now - Date, "h:mm")
    End If
    
    'D列に入れる値を設定（C列の値からB列の値を引く）
    TB2minusTB1 = Format(TimeValue(TB2Val) - TimeValue(TB1Val), "h:mm")
    
    
    'E列F列に入れる値を設定１（コンボボックス1〜2を巡回して値を取得）
    For i = LBound(CmbBoxes1) To UBound(CmbBoxes1)
        If CmbBoxes1(i).ListIndex >= 0 Then
            OnControls = OnControls & CmbBoxes1(i).Value & DLM
            tmpGroups = tmpGroups & CmbBoxGroup(i)(CmbBoxes1(i).ListIndex + 1, 1) & DLM
        End If
    Next
    
    'E列F列に入れる値を設定２（トグルボタンを巡回して値を取得）
    For i = 1 To 15
        With Me.Controls("ToggleButton" & i)
            If .Value Then
                OnControls = OnControls & .Caption & DLM
                tmpGroups = tmpGroups & .Tag & DLM
            End If
        End With
    Next
    
    'E列F列に入れる値を設定３（コンボボックス3〜5を巡回して値を取得）
    For i = LBound(CmbBoxes2) To UBound(CmbBoxes2)
        If CmbBoxes2(i).ListIndex >= 0 Then
            OnControls = OnControls & CmbBoxes2(i).Value & DLM
            For j = 0 To 3
                If Me.Controls("OptionButton" & i * 4 + j + 1).Value Then
                    tmpGroups = tmpGroups & GroupName(j) & DLM
                    Exit For
                End If
            Next
        End If
    Next
    
    'E列以降の値を配列にセットし直す（何もない場合は空配列にする）
    If OnControls <> "" Then
        OnControls = Split(OnControls, DLM)
    Else
        ReDim OnControls(0)
    End If
    
    If tmpGroups <> "" Then
        tmpGroups = Split(tmpGroups, DLM)
    Else
        ReDim tmpGroups(0)
    End If
    
    'E列に入れる値を設定４（コントロールを巡回して取得した値を整形）
    For i = LBound(GroupName) To UBound(GroupName)
        For j = LBound(tmpGroups) To UBound(tmpGroups)
            If tmpGroups(j) = GroupName(i) Then
                If OnGroups <> "" Then OnGroups = OnGroups & "+"
                OnGroups = OnGroups & GroupName(i)
                Exit For
            End If
        Next
    Next
    
    '書き込み先ブックを開く
    Set wb = Workbooks.Open(filePath & fileName)
    Set sh = wb.Worksheets(Month(Date) & "月")
    '書き込み先頭行を設定
    rowIdx = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'A〜F列に値を入力
    sh.Cells(rowIdx, 1).Value = Date
    sh.Cells(rowIdx, 2).Value = TB1Val
    sh.Cells(rowIdx, 3).Value = TB2Val
    sh.Cells(rowIdx, 4).Value = TB2minusTB1
    sh.Cells(rowIdx, 5).Value = OnGroups
    sh.Cells(rowIdx, 6).Resize(, UBound(OnControls) + 1).Value = OnControls
    
    'B〜D列の数値の表示形式を時刻の形に設定
    sh.Cells(rowIdx, 2).Resize(, 3).NumberFormatLocal = "hh:mm"
    
    '書き込み先ブックを保存し閉じる
    wb.Close Savechanges:=True
    
    'コントロールの値をリセット
    For Each ctl In Me.Controls
        Select Case TypeName(ctl)
            Case "TextBox", "ComboBox":          ctl.Value = ""
            Case "ToggleButton", "OptionButton": ctl.Value = False
        End Select
    Next
    
    MsgBox "保存完了"

 End Sub

 Private Function TimeStrTest(ByVal Arg As String) As Boolean
    Dim PatternStr As String
    PatternStr = "^([0-9]|[01][0-9]|2[0-3])[0-5][0-9]$"
    With CreateObject("VBScript.RegExp")
        .Pattern = PatternStr
        TimeStrTest = .test(Arg)
    End With
 End Function

 Private Function AddColon(Arg As String) As String
    AddColon = Left(Arg, Len(Arg) - 2) & ":" & Right(Arg, 2)
 End Function

試作4号です。
念のために書いておきますが、「こういう機能ができる」ことを念頭にコーディングしていますが
安全な動作については考慮していません。
エラー抑制用のコードも大方省いています。

すでに「無断で上書き」「無断で保存せず閉じる」機能も入っているほか、
さまざまなリスク含みのコードであることを念頭に置いてください。
最低限、コードを理解したうえで使用してください。
（めざめるパワー） 2021/09/14(火) 12:57
----
 お時間空いてしまいすいませんでした

ご対応いつもありがとうございます

今回は何度か試みましたが、
UserFormの表示が出来なくて
確認すらできません

 私の初歩的な何か悪い点がありますか？


（はせぴぃ） 2021/10/02(土) 09:11
----
＞ まず、トルグボタンを選択すると、
＞2-3個目で以前のものが解除されてしまいます。
UserFormから実行したんですよね。
なのになぜUserFormの表示が出来ないんですか。

（*?） 2021/10/02(土) 11:21
----
そうです

何かが影響してるのか
ユーザーフォームが表示されません。


（はせぴぃ） 2021/10/14(木) 10:10
----
なにかエラー表示が出ていますか？
あと、例示のコードは特に説明なくコントロール名を設定していますが実際に置いているものと名前は合っていますか？
（めざめるパワー） 2021/10/14(木) 10:15
----
実行時エラー'-2147024809(80070057)':
指定されたオブジェクトは見つかりません。

と出ます

（はせぴぃ） 2021/10/15(金) 10:00
----
オプションボタンがすでにある前提でコードを書いていますが実際はどうですか？

コードの注記に記したような
'末尾側コンボボックス用のオプションボタン設定（コンボボックス3個に4個ずつ＝12個）
すなわちOptionButton1〜12がなければそのエラーが発生します。
（めざめるパワー） 2021/10/15(金) 11:35