『勤務可能曜日を反映したシフト表の自動チェック』（おはし）
Excelについて質問です。
【シート1】
月〜金の時間割表になっており、各時間に担当する先生の名前を入力します。
【シート2】
先生ごとの勤務可能曜日を一覧にしています。
例：
山田先生｜月○｜火×｜水○｜木○｜金×
シート1に先生の名前を入力した際、シート2の勤務可能曜日を自動で参照し、
例えば「火曜日」に勤務不可（×）の先生が入っていた場合、そのセルを自動で赤くするなど、配置ミスを知らせる仕組みにしたいです。
このようなことは、関数や条件付き書式を使って設定できますでしょうか？
具体的な数式・設定方法を教えていただけると助かります。
＜ 使用 Excel：Excel2019、使用 OS：Windows11 ＞
条件付き書式で解決できる可能性があります。 具体的な数式を提示するには情報が不足しているので、 こちらで用意した例に対する回答です。 実情に応じて適宜修正するための参考にしてください。
【シート1】
|[A]|[B] |[C] |[D] |[E] |[F]
[1]| |月 |火 |水 |木 |金
[2]| 1|山田先生|山田先生|山田先生|山田先生|山田先生
[3]| 2|山田先生|鈴木先生|鈴木先生|鈴木先生|鈴木先生
[4]| 3|鈴木先生|佐藤先生|佐藤先生|佐藤先生|佐藤先生
[5]| 4| | | | |
[6]| 5| | | | |
[7]| 6| | | | |
【シート2】
|[A] |[B]|[C]|[D]|[E]|[F]
[1]|氏名 |月 |火 |水 |木 |金
[2]|山田先生|〇 |× |〇 |〇 |〇
[3]|鈴木先生|〇 |〇 |× |〇 |〇
[4]|佐藤先生|× |〇 |〇 |〇 |×
条件付き書式の設定 【シート1】のB2:F7を範囲選択し 条件付き書式の数式は以下、書式の塗りつぶしを赤色に設定。 =VLOOKUP(B2,Sheet2!$A:$F,COLUMN(B$1),0)="×" （朝駆け） 2026/09/13(日) 05:38:26
追加
シート2に存在しない先生名をシート1に入力した場合は、黄色に判定
実運用で、シート1の先生名を後から何度も変更するのであれば、
VBAを毎回実行する方式より、
シート1の先生名を入力・変更した瞬間に自動チェックして赤くするように
Worksheet_Changeを利用するのほうが実用的です。
Option Explicit
Sub 勤務判定()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim r As Long
Dim c As Long
Dim i As Long
Dim teacherName As String
Dim dayName As String
Dim result As String
Dim foundRow As Long
Set ws1 = Worksheets("シート1")
Set ws2 = Worksheets("シート2")
'----------------------------------------
' シート2の最終行
'----------------------------------------
lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'----------------------------------------
' シート1の最終行
'----------------------------------------
lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
'----------------------------------------
' シート1をチェック
' B列〜F列（月〜金）
'----------------------------------------
For r = 2 To lastRow1
For c = 2 To 6
teacherName = Trim(ws1.Cells(r, c).Value)
'空欄はチェックしない
If teacherName <> "" Then
dayName = Trim(ws1.Cells(1, c).Value)
'--------------------------------
' シート2から先生を検索
'--------------------------------
foundRow = 0
For i = 2 To lastRow2
If Trim(ws2.Cells(i, 1).Value) = teacherName Then
foundRow = i
Exit For
End If
Next i
'--------------------------------
' 先生が見つかった場合
'--------------------------------
If foundRow > 0 Then
'シート2の曜日列を取得
Select Case dayName
Case "月"
result = Trim(ws2.Cells(foundRow, 2).Value)
Case "火"
result = Trim(ws2.Cells(foundRow, 3).Value)
Case "水"
result = Trim(ws2.Cells(foundRow, 4).Value)
Case "木"
result = Trim(ws2.Cells(foundRow, 5).Value)
Case "金"
result = Trim(ws2.Cells(foundRow, 6).Value)
Case Else
result = ""
End Select
'--------------------------------
' 「×」なら赤色
'--------------------------------
If result = "×" Then
ws1.Cells(r, c).Interior.Color = RGB(255, 0, 0)
ws1.Cells(r, c).Font.Color = RGB(255, 255, 255)
Else
'〇なら通常状態に戻す
ws1.Cells(r, c).Interior.Pattern = xlNone
ws1.Cells(r, c).Font.Color = RGB(0, 0, 0)
End If
Else
'シート2に先生が存在しない場合
ws1.Cells(r, c).Interior.Color = RGB(255, 255, 0)
ws1.Cells(r, c).Font.Color = RGB(0, 0, 0)
End If
Else
'空欄なら色を解除
ws1.Cells(r, c).Interior.Pattern = xlNone
ws1.Cells(r, c).Font.Color = RGB(0, 0, 0)
End If
Next c
Next r
MsgBox "勤務可能曜日のチェックが完了しました。", vbInformation
End Sub
（詠み人知らず） 2026/09/13(日) 07:34:17
質問者さん希望の条件付き書式を使った回答案が出ていますので解決のように思いますが、 ご希望からははずれますが、こんなこともあるかなという話をメモします。
Sheet2の勤務可能者の表を基に、その曜日の可能者だけを集めたリストを別途作成(*1)しておき、 勤務可能者だけを入力規則のドロップダウンリストから選択してもらう、 という方法もあるかと思います。 入力負荷や慣れを考えるとプラス・マイナス両方の評価があるかと思いますが、 選択肢としてはありうるかと思います。
【注】 (*1)AGGREGATE関数を使うと、絞り込みができそうです。 (*2)入力規則の設定方法については、直近ありました [[20260820075038]] での議論が参考になりそうです。 （xyz） 2026/09/13(日) 08:24:46
Sheet2の勤務可能者の表を基に、その曜日の可能者だけを集めたリストをシート3に作成
勤務可能者だけのリストを元に入力規則のドロップダウンリストから選択する
Option Explicit
Sub 勤務可能者リスト作成_ドロップダウン設定()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lastRow As Long
Dim lastRow3 As Long
Dim r As Long
Dim c As Long
Dim outRow As Long
Dim teacherName As String
Dim rangeName As String
Set ws1 = Worksheets("シート1")
Set ws2 = Worksheets("シート2")
Set ws3 = Worksheets("シート3")
Application.ScreenUpdating = False
'==================================================
' シート3をクリア
'==================================================
ws3.Cells.Clear
'==================================================
' シート3に曜日を作成
'==================================================
For c = 2 To 6
ws3.Cells(1, c - 1).Value = ws2.Cells(1, c).Value
Next c
'==================================================
' シート2の最終行
'==================================================
lastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
'==================================================
' 曜日ごとの勤務可能者を作成
'==================================================
For c = 2 To 6
outRow = 2
For r = 2 To lastRow
teacherName = Trim(ws2.Cells(r, 1).Value)
If teacherName <> "" Then
If Trim(ws2.Cells(r, c).Value) = "〇" Then
ws3.Cells(outRow, c - 1).Value = teacherName
outRow = outRow + 1
End If
End If
Next r
'==================================================
' 曜日ごとの名前定義を作成
'==================================================
Select Case c
Case 2
rangeName = "月曜日"
Case 3
rangeName = "火曜日"
Case 4
rangeName = "水曜日"
Case 5
rangeName = "木曜日"
Case 6
rangeName = "金曜日"
End Select
'既存の名前定義を削除
On Error Resume Next
ThisWorkbook.Names(rangeName).Delete
On Error GoTo 0
'勤務可能者が存在する場合
If outRow > 2 Then
lastRow3 = outRow - 1
ThisWorkbook.Names.Add _
Name:=rangeName, _
RefersTo:="='" & ws3.Name & "'!" & _
ws3.Range(ws3.Cells(2, c - 1), _
ws3.Cells(lastRow3, c - 1)).Address
End If
Next c
'==================================================
' シート1の入力規則を設定
'==================================================
'既存の入力規則を削除
ws1.Range("B2:F1000").Validation.Delete
'----------------------------------------
' 月曜日 B列
'----------------------------------------
With ws1.Range("B2:B1000").Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:="=月曜日"
.IgnoreBlank = True
.InCellDropdown = True
.ShowError = True
End With
'----------------------------------------
' 火曜日 C列
'----------------------------------------
With ws1.Range("C2:C1000").Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:="=火曜日"
.IgnoreBlank = True
.InCellDropdown = True
.ShowError = True
End With
'----------------------------------------
' 水曜日 D列
'----------------------------------------
With ws1.Range("D2:D1000").Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:="=水曜日"
.IgnoreBlank = True
.InCellDropdown = True
.ShowError = True
End With
'----------------------------------------
' 木曜日 E列
'----------------------------------------
With ws1.Range("E2:E1000").Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:="=木曜日"
.IgnoreBlank = True
.InCellDropdown = True
.ShowError = True
End With
'----------------------------------------
' 金曜日 F列
'----------------------------------------
With ws1.Range("F2:F1000").Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:="=金曜日"
.IgnoreBlank = True
.InCellDropdown = True
.ShowError = True
End With
'==================================================
' シート3を見やすく
'==================================================
ws3.Rows(1).Font.Bold = True
ws3.Columns("A:E").AutoFit
Application.ScreenUpdating = True
MsgBox "勤務可能者リストとドロップダウンを設定しました。", vbInformation
End Sub
（詠み人知らず） 2026/09/13(日) 08:58:02
（fuji） 2026/09/14(月) 08:45:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.