不可勤務は、複数の勤務を指定できますので、
リストから必要な勤務をクリックして選択できると便利です。

選択処理の仕様

　・不可勤務の表内を選択すると、入力用のフォームを表示

　・この時、選択されたセルの項目を自動選択
　　　複数セルを選択された場合
　　　　　すべて同じ項目であれば、その勤務を自動選択
　　　　　異なる種類が混在している場合は選択しない

・フォームで項目を複数選択可

・フォームボタン　ＯＫボタン　－　表内の選択セルの値を更新
　　　　　　　　　　　Ｃａｎｃｅｌボタン　－　何もせずにフォームを閉じる

コンパイルエラー発生時

ワークシート制御用ＶＢＡ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' ワークシートセルの選択位置が変更された場合の処理
'
    Dim myCell As Range
    Dim tmp
    Dim No As Integer
    
    For Each myCell In Target   'はみ出していたら処理しない
        If Application.Intersect(Range("不可勤務"), myCell) Is Nothing Then
            Unload frm不可勤務
            Exit Sub
        End If
    Next


    ' 不可勤務内のみを選択した場合の処理
    
    Set rngSelect = Target '選択セル
    
    With frm不可勤務
    
        .Show vbModeless

        Dim k As Integer
        Dim Kinmus As String

    
        ' 選択域の値がすべて同じかを調べる
        Kinmus = Target.Cells(1)
        For k = 2 To Target.Cells.Count
            If Kinmus <> Target.Cells(k) Then '１番目と異なる？
                Kinmus = ""
                Exit For
            End If
        Next k

        
        With .ListBox1
        
            For k = 0 To .ListCount - 1 '選択を全て解除
                .Selected(k) = False
            Next k

            tmp = Split(Kinmus, ",") 'カンマ分割
            For k = 0 To UBound(tmp)
                No = KinmuNo(CStr(tmp(k)))
                If No > 0 Then
                    .Selected(No - 1) = True
                End If
            Next k
        
        End With
        
    End With
        
End Sub



Private Function KinmuNo(Kinmu As String) As Integer '勤務名→番号

    With Range("勤務リスト")
        
        Dim i  As Integer
        For i = 1 To .Rows.Count
            If Trim(Kinmu) = .Cells(i, 1) Then
                KinmuNo = i
                Exit For
            End If
        Next i
        
    End With
    
End Function

不可勤務入力用フォーム制御ＶＢＡ

Option Explicit

Private Sub cmdCancel_Click()
    Unload Me   'フォームを閉じる
End Sub

Private Sub cmdOK_Click()

    '選択された項目をシートに転記
    
    Dim i As Integer
    Dim tmp As String
    

    tmp = ""
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                If tmp <> "" Then tmp = tmp & ","
                tmp = tmp & .List(i)
            End If
        Next i
    End With
    rngSelect.Value = tmp

End Sub

Private Sub UserForm_Initialize()
    
    '項目リスト作成
    
    Dim i As Integer
    Dim tmp As Range
    
    Set tmp = Range("勤務リスト")
    With ListBox1
        .Clear
        For i = 1 To tmp.Rows.Count
            .AddItem tmp(i)
        Next i
    End With
End Sub

コントロール ・リストボックス 　プロパティは左図参照 ・コマンドボタン　ｘ２

次項では、氏名人数を任意にできるように改良。
氏名人数の変更により、変化するセルの範囲が変化するので工夫が必要。

関連