予約勤務と連続不可勤務との重複

数式の説明

MyReplaceAll関数は、範囲内のセルの文字を変換テーブルに従い置換
myconnectall関数は、範囲内のセルの文字をすべて連結、ただし、空白セルは半角スペース" "とする。
IF関数で判定しているのは、「前旬使用」がオンの場合は、前旬列データを含めて連結するため。
（オフの場合は、今旬データのみ）

=MyReplaceAll(IF(前旬使用,myconnectall(D20:J20,, "―"),"")&myconnectall(K20:Q20,," "),勤務変換表)
{=COUNT(IF($Y$12:$Y$16="","",IFERROR(FIND($Y$12:$Y$16,R20),"")))}

「予約表」内の条件付き書式

予約勤務と不可勤務との重複

予約勤務と不可勤務との重複
同じ勤務を予約と不可に設定はできないので、重複した場合は赤で塗り潰すようにします。

条件付き書式
予約で設定されたデータを、同じ位置の不可勤務から探し、見つかった場合に塗り潰します。
不可勤務では複数の勤務を指定できるので、カンマ区切りのデータとしてSEARCH関数で探します。

不可勤務のデータの前後に「,」を付加、予約のデータの前後にも「,」を付加することにより、
「,日,」のようにカンマで挟まれたデータを探すことができます。

不可、予約の両表に設定

不可勤務表 =AND(K12<>"",ISERROR(SEARCH("*," & K12 & ",*",","&K19&","))=FALSE)

予約勤務表 =AND(K19<>"",ISERROR(SEARCH("*," & K12 & ",*",","&K19&","))=FALSE)

勤務色の自動反映

勤務名の背景色、文字色をシフト表に自動で反映します。
入力部の勤務名のセルで背景色、または文字色を設定しておくと、作成後のシフト表に反映されます。

色を変更後、すぐにシフト表に反映したい場合は「勤務色更新」ボタンをクリックします。
（配色を確認したい場合など）

ソースコード　－　勤務色設定部

'------------------------------------------
' サブルーチン
'------------------------------------------

Private Sub SetKinmuCellColor(範囲 As Range)
'
' 指定範囲を勤務に応じたセル色にセット
'
    Application.ScreenUpdating = False  '画面更新停止
    Dim tmp As Range
    For Each tmp In 範囲
        tmp.Interior.Color = KinmuColor(tmp.Value)
        tmp.Font.Color = KinmuFontColor(tmp.Value)
    Next
    Application.ScreenUpdating = True  '画面更新再開
End Sub

'-------------------------------------------
' 勤務名変換関数
'-------------------------------------------

Function Kinmu(No As Integer) As String
'
' 番号を勤務名に変換
'
    Kinmu = ""
    With Range("勤務リスト")
        If No >= 1 And No <= .Rows.Count Then
            Kinmu = .Cells(No)
        End If
    End With
    
End Function

Function KinmuNo(Kinmu As String) As Integer ' 勤務名を番号に変換
    KinmuNo = GetKinmu(Kinmu, "勤務番号")
End Function

Function KinmuColor(Kinmu As String) As Long ' 勤務名を背景色に変換
    KinmuColor = GetKinmu(Kinmu, "背景色")
End Function

Function KinmuFontColor(Kinmu As String) As Long ' 勤務名を文字色に変換
    KinmuFontColor = GetKinmu(Kinmu, "文字色")
End Function

Function GetKinmu(Kinmu As String, 取得種別 As String) As Long
'
' 勤務名に応じた情報取得
'
    GetKinmu = -1
    With Range("勤務リスト")
        
        Dim i  As Integer
        For i = 1 To .Rows.Count
            If Strings.Trim(Kinmu) = .Cells(i, 1) Then
                Select Case 取得種別
                    Case "勤務番号": GetKinmu = i
                    Case "背景色":   GetKinmu = .Cells(i, 1).Interior.Color
                    Case "文字色":   GetKinmu = .Cells(i, 1).Font.Color
                    Case Else
                End Select
            End If
        Next i
        
    End With
    
End Function

以下のタイミングで呼び出される

・「勤務色更新」ボタンクリック
・「初期化」ボタンクリック
・シフト表作成後の最終処理部

関連