Excel VBA 逆引き集 | バリデーション総合テンプレ

Excel VBA
スポンサーリンク

バリデーション総合テンプレ

入力チェックを一箇所にまとめて、分かりやすく・使い回しやすくする「総合テンプレート」を用意しました。必須、型、桁数、文字種、禁止文字、範囲、日付、複合ルールまでを一括で扱えます。初心者でもそのまま貼って使える構成にしています。

設計の全体像

  • 構成:
    • 共通関数群（必須、数値、整数、桁数、文字種、禁止文字、日付、範囲）
    • エラー収集（配列 or Collection）
    • 行単位の検証（ValidateRow）
    • シート全体の検証（ValidateSheet）
  • 考え方:
    • 入力ごとに「何をチェックするか」をルール化し、エラーメッセージは具体的に。
    • 失敗した項目はすべて集めて一度に表示（ユーザーが直しやすい）。
  • 使い分け:
    • 開発中はDebug.Printで詳細ログ、運用はメッセージ＋必要ならエラーシート出力。

共通バリデーション関数（貼って使う）

' === 基本ユーティリティ ===
Public Function IsBlankOrNull(ByVal v As Variant) As Boolean
    IsBlankOrNull = (IsEmpty(v) Or IsNull(v) Or v = "")
End Function

Public Function IsDigitsOnly(ByVal s As String) As Boolean
    If s = "" Then IsDigitsOnly = False: Exit Function
    IsDigitsOnly = Not (s Like "*[!0-9]*")
End Function

Public Function ContainsForbidden(ByVal s As String, ByVal forbidden As String) As Boolean
    ' forbidden は "@#$%" のような文字集合
    ContainsForbidden = (s Like "*[" & forbidden & "]*")
End Function

Public Function IsAlphabetOnly(ByVal s As String) As Boolean
    If s = "" Then IsAlphabetOnly = False: Exit Function
    IsAlphabetOnly = Not (s Like "*[!A-Za-z]*")
End Function

Public Function IsKatakanaOnly(ByVal s As String) As Boolean
    Dim i As Long, ch As String, code As Long
    If s = "" Then IsKatakanaOnly = False: Exit Function
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        code = AscW(ch)
        If code < 12449 Or code > 12538 Then
            IsKatakanaOnly = False
            Exit Function
        End If
    Next
    IsKatakanaOnly = True
End Function

Public Function IsIntegerValue(ByVal v As Variant) As Boolean
    If Not IsNumeric(v) Then IsIntegerValue = False: Exit Function
    IsIntegerValue = (CDbl(v) = Int(CDbl(v)))
End Function

Public Function IsWithinLength(ByVal s As String, ByVal minLen As Long, ByVal maxLen As Long) As Boolean
    Dim L As Long: L = Len(s)
    IsWithinLength = (L >= minLen And L <= maxLen)
End Function

Public Function IsWithinRange(ByVal x As Double, ByVal minVal As Double, ByVal maxVal As Double) As Boolean
    IsWithinRange = (x >= minVal And x <= maxVal)
End Function

Public Function IsValidDate(ByVal v As Variant) As Boolean
    IsValidDate = IsDate(v)
End Function

Public Function IsWithinDateRange(ByVal v As Variant, ByVal dMin As Date, ByVal dMax As Date) As Boolean
    If Not IsDate(v) Then IsWithinDateRange = False: Exit Function
    Dim d As Date: d = CDate(v)
    IsWithinDateRange = (d >= dMin And d <= dMax)
End Function
VB

行単位の検証テンプレ（例題付き）

前提の入力ルール

  • A列（社員番号）: 半角数字のみ・桁数6
  • B列（氏名カナ）: 全角カタカナのみ・1〜30文字
  • C列（数量）: 整数・1〜1000
  • D列（受注日）: 日付・2024/1/1〜2025/12/31
  • E列（備考）: 禁止文字「@#$%」は含まない
' 1行分を検証して、エラーをCollectionで返す
Public Function ValidateRow(ByVal ws As Worksheet, ByVal row As Long) As Collection
    Dim errs As New Collection
    Dim empNo As String, nameKana As String, qty As Variant, orderDate As Variant, note As String
    
    empNo = CStr(ws.Cells(row, "A").Value)
    nameKana = CStr(ws.Cells(row, "B").Value)
    qty = ws.Cells(row, "C").Value
    orderDate = ws.Cells(row, "D").Value
    note = CStr(ws.Cells(row, "E").Value)
    
    ' A: 社員番号
    If IsBlankOrNull(empNo) Then
        errs.Add "A" & row & ": 社員番号が未入力です。"
    Else
        If Not IsDigitsOnly(empNo) Then errs.Add "A" & row & ": 社員番号は半角数字のみです。"
        If Len(empNo) <> 6 Then errs.Add "A" & row & ": 社員番号は6桁で入力してください。"
    End If
    
    ' B: 氏名カナ
    If IsBlankOrNull(nameKana) Then
        errs.Add "B" & row & ": 氏名カナが未入力です。"
    Else
        If Not IsKatakanaOnly(nameKana) Then errs.Add "B" & row & ": 氏名カナは全角カタカナのみです。"
        If Not IsWithinLength(nameKana, 1, 30) Then errs.Add "B" & row & ": 氏名カナは1～30文字で入力してください。"
    End If
    
    ' C: 数量
    If IsBlankOrNull(qty) Then
        errs.Add "C" & row & ": 数量が未入力です。"
    Else
        If Not IsIntegerValue(qty) Then errs.Add "C" & row & ": 数量は整数で入力してください。"
        If IsNumeric(qty) Then
            If Not IsWithinRange(CDbl(qty), 1, 1000) Then errs.Add "C" & row & ": 数量は1～1000の範囲で入力してください。"
        End If
    End If
    
    ' D: 受注日
    If IsBlankOrNull(orderDate) Then
        errs.Add "D" & row & ": 受注日が未入力です。"
    Else
        If Not IsValidDate(orderDate) Then
            errs.Add "D" & row & ": 受注日は日付で入力してください。"
        Else
            If Not IsWithinDateRange(orderDate, DateSerial(2024, 1, 1), DateSerial(2025, 12, 31)) Then
                errs.Add "D" & row & ": 受注日は 2024/1/1～2025/12/31 の範囲で入力してください。"
            End If
        End If
    End If
    
    ' E: 備考
    If Len(note) > 0 Then
        If ContainsForbidden(note, "@#$%") Then errs.Add "E" & row & ": 備考に禁止文字（@#$%）が含まれています。"
    End If
    
    Set ValidateRow = errs
End Function

' 使い方例：A2:E21の各行を検証して結果表示
Public Sub ValidateSheet()
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim r As Long, errs As Collection, e As Variant, allMsg As String
    Dim startRow As Long: startRow = 2
    Dim endRow As Long: endRow = 21
    
    allMsg = ""
    For r = startRow To endRow
        Set errs = ValidateRow(ws, r)
        If errs.Count > 0 Then
            Dim msg As String: msg = ""
            For Each e In errs
                msg = msg & e & vbCrLf
            Next
            allMsg = allMsg & msg
        End If
    Next
    
    If allMsg = "" Then
        MsgBox "入力チェックOK（エラーなし）"
    Else
        MsgBox "入力エラーがあります：" & vbCrLf & allMsg
    End If
End Sub
VB

応用テンプレ（クロス項目・形式指定・自動整形）

' 郵便番号（ハイフンあり可）: 半角数字7桁に整形してチェック
Public Function NormalizePostalCode(ByVal s As String) As String
    Dim i As Long, ch As String, onlyDigits As String
    onlyDigits = ""
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        If ch Like "[0-9]" Then onlyDigits = onlyDigits & ch
    Next
    NormalizePostalCode = onlyDigits
End Function

Public Function ValidatePostalCode(ByVal s As String) As String
    Dim d As String: d = NormalizePostalCode(s)
    If Len(d) <> 7 Then
        ValidatePostalCode = "郵便番号は数字7桁で入力してください。"
    Else
        ValidatePostalCode = "" ' OK
    End If
End Function

' クロス項目例: 受注日 <= 納期 の妥当性
Public Function ValidateOrderDeadline(ByVal orderDate As Variant, ByVal deadline As Variant) As String
    If Not IsValidDate(orderDate) Or Not IsValidDate(deadline) Then
        ValidateOrderDeadline = "受注日と納期は日付で入力してください。"
        Exit Function
    End If
    If CDate(orderDate) > CDate(deadline) Then
        ValidateOrderDeadline = "納期は受注日以降の日付にしてください。"
        Exit Function
    End If
    ValidateOrderDeadline = "" ' OK
End Function
VB

実務で効く運用のコツ

  • メッセージは具体的に:
    • 項目名＋何がダメか＋正しい例を短く。
  • すべてのエラーを一度に提示:
    • まとめ表示で修正往復を減らす。
  • 自動整形でユーザー負担を軽減:
    • 郵便番号・電話番号は数字抽出後に桁チェック。
  • 検証と書き込みを分ける:
    • まず検証で「OK」になったものだけを確定処理。
  • 開発中は詳細ログ:
    • Debug.Printで通過点と入力値をトレース。

最小セットで始めたい人向け（超軽量版）

Sub ValidateMinimal()
    Dim ws As Worksheet: Set ws = Worksheets("Input")
    Dim msg As String: msg = ""
    
    ' 社員番号 A2
    Dim empNo As String: empNo = CStr(ws.Range("A2").Value)
    If IsBlankOrNull(empNo) Then msg = msg & "A2: 社員番号が未入力。" & vbCrLf
    If Len(empNo) <> 6 Or Not IsDigitsOnly(empNo) Then msg = msg & "A2: 社員番号は半角数字6桁。" & vbCrLf
    
    ' 数量 C2
    Dim qty As Variant: qty = ws.Range("C2").Value
    If Not IsIntegerValue(qty) Or Not IsWithinRange(CDbl(qty), 1, 1000) Then _
        msg = msg & "C2: 数量は1～1000の整数。" & vbCrLf
    
    If msg = "" Then
        MsgBox "OK"
    Else
        MsgBox "入力エラー：" & vbCrLf & msg
    End If
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました