[[20210901202739]]　『勤務表』（ちび）　ページの最後に飛ぶ

『勤務表』（ちび）

月間の勤務表をつくりたく、主婦が多いため、日々その日の出勤者が変わります。
変わる度、別シートに作成したカレンダーに、その日の出勤者名がてんきされるようにしたいです。

＜使用 Excel：unknown、使用 OS：Windows10 ＞

残念ながら回答者側には、あなたの画面が見えないのでやりたいことだけを書かれてもお困りのポイントがわかりません。

表とカレンダー　それぞれのシートレイアウトを行、列の情報付きで示されると回答率がアップするとおもうので、まずはそちらを提示してみてはどうでしょうか？

（もこな２） 2021/09/01(水) 20:49

 Dim WithEvents btn As MSForms.CommandButton
 Dim tgl() As MSForms.ToggleButton
 Dim tBox As MSForms.TextBox

 Private Sub UserForm_Initialize()
    Dim lastRow As Long
    Dim iTop As Long
    Dim i As Long
    Set tBox = Me.Controls.Add("Forms.TextBox.1", "DateInputBox")
    With tBox
        .Top = 12
        .Left = 12
        .Width = 120
        .Value = Format(Date, "yyyy/mm/dd")
        iTop = .Top + .Height + 12
    End With
    lastRow = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    ReDim tgl(1 To lastRow)
    For i = 1 To lastRow
        Set tgl(i) = Me.Controls.Add("Forms.ToggleButton.1", "NameBox" & i)
        With tgl(i)
            .Top = iTop
            .Left = 12
            .Width = 80
            .Height = 20
            .Caption = Worksheets(1).Cells(i, "A").Value
            iTop = .Top + .Height + 6
        End With
    Next
    iTop = iTop + 6
    Set btn = Me.Controls.Add("Forms.CommandButton.1", "SubmitButton")
    With btn
        .Top = iTop
        .Left = 12
        .Width = 120
        .Caption = "OK"
        iTop = .Top + .Height + 6
    End With
    Me.Height = iTop + Me.Height - Me.InsideHeight
 End Sub

 Private Sub btn_Click()
    Dim SearchRange As Range
    Dim dValue As Double
    Dim delimiter As String
    Dim tmp As String
    Dim iRow As Variant
    Dim i As Long

    If Not IsDate(tBox.Value) Then Exit Sub
    dValue = DateValue(tBox.Value)
    With Worksheets(2)
        Set SearchRange = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
    End With
    iRow = Application.Match(dValue, SearchRange, 0)
    If IsError(iRow) Then Exit Sub

    delimiter = " "
    For i = LBound(tgl) To UBound(tgl)
        If tgl(i).Value Then
            tmp = tmp & tgl(i).Caption & delimiter
        End If
    Next i
    If Len(tmp) < 1 Then Exit Sub

    tmp = Left(tmp, Len(tmp) - Len(delimiter))
    Worksheets(2).Cells(iRow, "B").Value = tmp
    tBox.Value = Format(dValue + 1, "yyyy/mm/dd")
 End Sub

試作品です。
ワークシート１のA列にある値をユーザーフォームにトグルボタン一覧で表示します。
OKボタンを押すとワークシート２のA列の中からテキストボックスと同一値を探して
みつかった場合はB列にトグルがONになっている名前を合成した文字列を転記します。
（めざめるパワー） 2021/09/02(木) 10:54

コメント返信：

[ 一覧(最新更新順) ]

[[20210901202739]] 『勤務表』（ちび） ページの最後に飛ぶ

[[20210901202739]]　『勤務表』（ちび）　ページの最後に飛ぶ