'再計算時にセルの値を自動チェックするサンプルマクロ

'MakeSheet11を実行してサンプルシートを作成してください。

Option Explicit

Dim sheetName As String

Sub MakeSheet11()
    Dim i As Integer
    Worksheets.Add
    Range("A5").Value = "項目1（1,2,3）"
    Range("B5").Value = 1
    Range("A7").Value = "項目2（リストに存在するもの）"
    Range("A9").Value = "項目3（0から100）"
    Columns(1).AutoFit
    With Range("A1")
        .Value = "再計算時にセルの値を自動チェックするサンプルシート"
        With .Font
            .ColorIndex = 5
            .Bold = True
        End With
    End With
    Range("A2").Value = "再計算時にすべての入力セルのチェックを行います。"
    Range("A3").Value = "再計算を発生させるために隠し数式を使っています。"
    Range("E1").Value = "隠し数式"
    Range("E2").Formula = "=IF(AND(ISERROR(B9)),"""","""")"
    Range("F1").Value = "項目1のリスト"
    Range("F2").Value = "Aタイプ"
    Range("F3").Value = "Bタイプ"
    Range("F4").Value = "Cタイプ"
    Range("G1").Value = "項目2のリスト"
    With Range("G2")
        For i = 1 To 5
            .Cells(i, 1).Value = 100 + i
            .Cells(i, 2).Value = "Name" & i
        Next
    End With
    Range("C5").Formula = "=INDEX($F$2:$F$4,B5)"
    Range("C7").Formula = "=IF(B7="""","""",VLOOKUP(B7,$G$2:$H$6,2,FALSE))"
    Range("B5,C5,B7,C7,B9").BorderAround Weight:=xlThick, ColorIndex:=14
    Range("B5,B7,B9").Locked = False
    Range("B5").Select
    MySheetActivate11_On
    ActiveSheet.Protect , True, True, True
End Sub

'アクティブシートに自動実行マクロを登録するマクロ
Sub MySheetActivate11_On()
    ActiveSheet.OnSheetActivate = "MySheetActivate11"
    ActiveSheet.OnSheetDeactivate = "MySheetDeactivate11"
    MySheetActivate11
End Sub

'アクティブシートの自動実行マクロを解除するマクロ
Sub MySheetActivate11_Off()
    ActiveSheet.OnSheetActivate = ""
    ActiveSheet.OnSheetDeactivate = ""
    MySheetDeactivate11
End Sub

'キーの割り当てをするマクロ（自動実行マクロ）
Sub MySheetActivate11()
    Application.OnKey "{ENTER}", "MyKeyEnter11"
    Application.OnKey "{RETURN}", "MyKeyEnter11"
    Application.OnKey "+{ENTER}", "MyKeyShiftEnter11"
    Application.OnKey "+{RETURN}", "MyKeyShiftEnter11"
    ActiveSheet.OnCalculate = "MyCalculate11"
    Application.Calculation = xlAutomatic
    sheetName = ActiveSheet.Name
End Sub

'キーの割り当てを解除するマクロ（自動実行マクロ）
Sub MySheetDeactivate11()
    Application.OnKey "{ENTER}"
    Application.OnKey "{RETURN}"
    Application.OnKey "+{ENTER}"
    Application.OnKey "+{RETURN}"
End Sub

'Enterで起動するマクロ
Sub MyKeyEnter11()
    ActiveCell.Next.Activate
End Sub

'Shift+Enterで起動するマクロ
Sub MyKeyShiftEnter11()
    ActiveCell.Previous.Activate
End Sub

Sub MyCalculate11()
    Dim flag As Boolean
    Dim v As Variant

    If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
    If ActiveSheet.Name <> sheetName Then Exit Sub

    With ActiveSheet.Range("B5")
        flag = True
        v = .Value
        If IsNumeric(v) Then
            If v = Int(v) Then
                If v >= 1 And v <= 3 Then
                    flag = False
                End If
            End If
        End If
        If flag Then
            .Select
            .Value = 1
            MsgBox "1から3の数値を入力してください。", vbExclamation
            Exit Sub
        End If
    End With

    With ActiveSheet.Range("B7")
        If IsError(.Offset(0, 1).Value) Then
            .Select
            .Value = ""
            MsgBox "該当するデータがありません。", vbExclamation
            Exit Sub
        End If
    End With

    With ActiveSheet.Range("B9")
        flag = True
        v = .Value
        If IsNumeric(v) Then
            If v = Int(v) Then
                If v >= 0 And v <= 100 Then
                    flag = False
                End If
            End If
        End If
        If flag Then
            .Select
            .Value = ""
            MsgBox "0から100の数値を入力してください。", vbExclamation
            Exit Sub
        End If
    End With
End Sub