Option Explicit
 
Public Sub 必須項目チェック()
    Const Basecol As Long = 6   'E列
    Dim maxrow As Long          '最大行
    Dim maxcol As Long          '最大列
    Dim wrow As Long            '行番号
    Dim wcol As Long            '列番号
    Dim ret As Long
    Dim ws As Worksheet         '本シート
    Dim mval() As String        '必須の値
    Dim flag() As Boolean       '必須フラグ（True:必須、False:必須でない）
    Dim wstr As String          '文字（数値）
    Dim cnt As Long             '件数カウンター
    Set ws = ActiveSheet
    maxrow = ws.Cells(Rows.Count, Basecol).End(xlUp).Row        'F列の最大行取得
    maxcol = ws.Cells(2, Columns.Count).End(xlToLeft).Column    '2行目の最終列を求める
    If maxrow < 4 Then Exit Sub
    If maxcol < 2 Then Exit Sub
    ReDim mval(1 To maxcol)
    ReDim flag(1 To maxrow, 1 To maxcol)
    'フラグクリア
    For wrow = 1 To maxrow
        For wcol = 1 To maxcol
            flag(wrow, wcol) = False
        Next
    Next
    '背景色クリア
    ws.Range(ws.Cells(4, 2), ws.Cells(maxrow, maxcol)).Interior.Pattern = xlNone
    '必須の値作成
    For wcol = 1 To maxcol
        '「○○の必須」から「○○」を取り出す
        mval(wcol) = Replace(ws.Cells(2, wcol).Value, "の必須", "")
    Next
    'F列の値が必須となるセルを記憶する
    '4行～最終行まで繰り返す
    For wrow = 4 To maxrow
        wstr = ws.Cells(wrow, Basecol).Value
        If wstr = "" Then
            MsgBox ("F列の" & wrow & "行が空白です")
            ws.Cells(wrow, Basecol).Select
            Exit Sub
        End If
        cnt = 0
        '2列～最終列まで繰り返す
        For wcol = 2 To maxcol
            If wcol <> Basecol Then
                '必須の値が一致するなら該当セルのフラグへTrueを設定
                If wstr = mval(wcol) Then
                    flag(wrow, wcol) = True
                    cnt = cnt + 1
                End If
            End If
        Next
        '1件も一致する列がないならエラー
        If cnt = 0 Then
            MsgBox ("F列の" & wrow & "行の値が不正です")
            ws.Cells(wrow, Basecol).Select
            Exit Sub
        End If
    Next
    '必須となるセルに値が記入されているかチェックする
    cnt = 0
    'チェック範囲の全セルをチェックする
    For wrow = 4 To maxrow
        For wcol = 2 To maxcol
            '必須であるセルが空白なら、背景色を設定する
            If flag(wrow, wcol) = True Then
                If ws.Cells(wrow, wcol) = "" Then
                    ws.Cells(wrow, wcol).Interior.Color = 49407     'オレンジ
                    cnt = cnt + 1
                End If
            End If
        Next
    Next
    If cnt = 0 Then
        MsgBox ("チェック完了")
    Else
        MsgBox ("必須項目データなし=" & cnt & "件")
    End If
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOW/hemgiOmgheebruODgeOCp+ODg+OCrygpCiAgICBDb25zdCBCYXNlY29sIEFzIExvbmcgPSA2ICAgJ0XliJcKICAgIERpbSBtYXhyb3cgQXMgTG9uZyAgICAgICAgICAn5pyA5aSn6KGMCiAgICBEaW0gbWF4Y29sIEFzIExvbmcgICAgICAgICAgJ+acgOWkp+WIlwogICAgRGltIHdyb3cgQXMgTG9uZyAgICAgICAgICAgICfooYznlarlj7cKICAgIERpbSB3Y29sIEFzIExvbmcgICAgICAgICAgICAn5YiX55Wq5Y+3CiAgICBEaW0gcmV0IEFzIExvbmcKICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQgICAgICAgICAn5pys44K344O844OICiAgICBEaW0gbXZhbCgpIEFzIFN0cmluZyAgICAgICAgJ+W/hemgiOOBruWApAogICAgRGltIGZsYWcoKSBBcyBCb29sZWFuICAgICAgICflv4XpoIjjg5Xjg6njgrDvvIhUcnVlOuW/hemgiOOAgUZhbHNlOuW/hemgiOOBp+OBquOBhO+8iQogICAgRGltIHdzdHIgQXMgU3RyaW5nICAgICAgICAgICfmloflrZfvvIjmlbDlgKTvvIkKICAgIERpbSBjbnQgQXMgTG9uZyAgICAgICAgICAgICAn5Lu25pWw44Kr44Km44Oz44K/44O8CiAgICBTZXQgd3MgPSBBY3RpdmVTaGVldAogICAgbWF4cm93ID0gd3MuQ2VsbHMoUm93cy5Db3VudCwgQmFzZWNvbCkuRW5kKHhsVXApLlJvdyAgICAgICAgJ0bliJfjga7mnIDlpKfooYzlj5blvpcKICAgIG1heGNvbCA9IHdzLkNlbGxzKDIsIENvbHVtbnMuQ291bnQpLkVuZCh4bFRvTGVmdCkuQ29sdW1uICAgICcy6KGM55uu44Gu5pyA57WC5YiX44KS5rGC44KB44KLCiAgICBJZiBtYXhyb3cgPCA0IFRoZW4gRXhpdCBTdWIKICAgIElmIG1heGNvbCA8IDIgVGhlbiBFeGl0IFN1YgogICAgUmVEaW0gbXZhbCgxIFRvIG1heGNvbCkKICAgIFJlRGltIGZsYWcoMSBUbyBtYXhyb3csIDEgVG8gbWF4Y29sKQogICAgJ+ODleODqeOCsOOCr+ODquOCogogICAgRm9yIHdyb3cgPSAxIFRvIG1heHJvdwogICAgICAgIEZvciB3Y29sID0gMSBUbyBtYXhjb2wKICAgICAgICAgICAgZmxhZyh3cm93LCB3Y29sKSA9IEZhbHNlCiAgICAgICAgTmV4dAogICAgTmV4dAogICAgJ+iDjOaZr+iJsuOCr+ODquOCogogICAgd3MuUmFuZ2Uod3MuQ2VsbHMoNCwgMiksIHdzLkNlbGxzKG1heHJvdywgbWF4Y29sKSkuSW50ZXJpb3IuUGF0dGVybiA9IHhsTm9uZQogICAgJ+W/hemgiOOBruWApOS9nOaIkAogICAgRm9yIHdjb2wgPSAxIFRvIG1heGNvbAogICAgICAgICfjgIzil4vil4vjga7lv4XpoIjjgI3jgYvjgonjgIzil4vil4vjgI3jgpLlj5bjgorlh7rjgZkKICAgICAgICBtdmFsKHdjb2wpID0gUmVwbGFjZSh3cy5DZWxscygyLCB3Y29sKS5WYWx1ZSwgIuOBruW/hemgiCIsICIiKQogICAgTmV4dAogICAgJ0bliJfjga7lgKTjgYzlv4XpoIjjgajjgarjgovjgrvjg6vjgpLoqJjmhrbjgZnjgosKICAgICc06KGM772e5pyA57WC6KGM44G+44Gn57mw44KK6L+U44GZCiAgICBGb3Igd3JvdyA9IDQgVG8gbWF4cm93CiAgICAgICAgd3N0ciA9IHdzLkNlbGxzKHdyb3csIEJhc2Vjb2wpLlZhbHVlCiAgICAgICAgSWYgd3N0ciA9ICIiIFRoZW4KICAgICAgICAgICAgTXNnQm94ICgiRuWIl+OBriIgJiB3cm93ICYgIuihjOOBjOepuueZveOBp+OBmSIpCiAgICAgICAgICAgIHdzLkNlbGxzKHdyb3csIEJhc2Vjb2wpLlNlbGVjdAogICAgICAgICAgICBFeGl0IFN1YgogICAgICAgIEVuZCBJZgogICAgICAgIGNudCA9IDAKICAgICAgICAnMuWIl++9nuacgOe1guWIl+OBvuOBp+e5sOOCiui/lOOBmQogICAgICAgIEZvciB3Y29sID0gMiBUbyBtYXhjb2wKICAgICAgICAgICAgSWYgd2NvbCA8PiBCYXNlY29sIFRoZW4KICAgICAgICAgICAgICAgICflv4XpoIjjga7lgKTjgYzkuIDoh7TjgZnjgovjgarjgonoqbLlvZPjgrvjg6vjga7jg5Xjg6njgrDjgbhUcnVl44KS6Kit5a6aCiAgICAgICAgICAgICAgICBJZiB3c3RyID0gbXZhbCh3Y29sKSBUaGVuCiAgICAgICAgICAgICAgICAgICAgZmxhZyh3cm93LCB3Y29sKSA9IFRydWUKICAgICAgICAgICAgICAgICAgICBjbnQgPSBjbnQgKyAxCiAgICAgICAgICAgICAgICBFbmQgSWYKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgTmV4dAogICAgICAgICcx5Lu244KC5LiA6Ie044GZ44KL5YiX44GM44Gq44GE44Gq44KJ44Ko44Op44O8CiAgICAgICAgSWYgY250ID0gMCBUaGVuCiAgICAgICAgICAgIE1zZ0JveCAoIkbliJfjga4iICYgd3JvdyAmICLooYzjga7lgKTjgYzkuI3mraPjgafjgZkiKQogICAgICAgICAgICB3cy5DZWxscyh3cm93LCBCYXNlY29sKS5TZWxlY3QKICAgICAgICAgICAgRXhpdCBTdWIKICAgICAgICBFbmQgSWYKICAgIE5leHQKICAgICflv4XpoIjjgajjgarjgovjgrvjg6vjgavlgKTjgYzoqJjlhaXjgZXjgozjgabjgYTjgovjgYvjg4Hjgqfjg4Pjgq/jgZnjgosKICAgIGNudCA9IDAKICAgICfjg4Hjgqfjg4Pjgq/nr4Tlm7Ljga7lhajjgrvjg6vjgpLjg4Hjgqfjg4Pjgq/jgZnjgosKICAgIEZvciB3cm93ID0gNCBUbyBtYXhyb3cKICAgICAgICBGb3Igd2NvbCA9IDIgVG8gbWF4Y29sCiAgICAgICAgICAgICflv4XpoIjjgafjgYLjgovjgrvjg6vjgYznqbrnmb3jgarjgonjgIHog4zmma/oibLjgpLoqK3lrprjgZnjgosKICAgICAgICAgICAgSWYgZmxhZyh3cm93LCB3Y29sKSA9IFRydWUgVGhlbgogICAgICAgICAgICAgICAgSWYgd3MuQ2VsbHMod3Jvdywgd2NvbCkgPSAiIiBUaGVuCiAgICAgICAgICAgICAgICAgICAgd3MuQ2VsbHMod3Jvdywgd2NvbCkuSW50ZXJpb3IuQ29sb3IgPSA0OTQwNyAgICAgJ+OCquODrOODs+OCuAogICAgICAgICAgICAgICAgICAgIGNudCA9IGNudCArIDEKICAgICAgICAgICAgICAgIEVuZCBJZgogICAgICAgICAgICBFbmQgSWYKICAgICAgICBOZXh0CiAgICBOZXh0CiAgICBJZiBjbnQgPSAwIFRoZW4KICAgICAgICBNc2dCb3ggKCLjg4Hjgqfjg4Pjgq/lrozkuoYiKQogICAgRWxzZQogICAgICAgIE1zZ0JveCAoIuW/hemgiOmgheebruODh+ODvOOCv+OBquOBlz0iICYgY250ICYgIuS7tiIpCiAgICBFbmQgSWYKRW5kIFN1Ygo=