Excel VBA | 汎用チェック関数ライブラリ（必須・数値・日付対応）

Excel VBA VBA
2010.04.08
スポンサーリンク

実務で使い回せる入力チェックをモジュール化したライブラリです。各関数は「正常なら空文字、不正ならエラーメッセージ」を返します。組み合わせて使えるよう、行単位の一括検証関数も用意しています。

モジュール構成と設計指針

  • 戻り値のルール: 正常は空文字、不正は人に伝わる日本語のメッセージ。
  • 拡張しやすさ: 追加チェック（範囲・正規表現など）を同スタイルで増やせる。
  • 一括検証: フィールド名と値を渡して、複数チェックを同時に評価可能。

ライブラリコード（標準モジュールに貼り付け）

' ===== ValidationLib.bas =====

Option Explicit

'--- 基本チェック ---

' 必須入力チェック
Function CheckRequired(ByVal value As Variant, ByVal fieldName As String) As String
    Dim s As String
    s = Trim(CStr(value))
    If s = "" Then
        CheckRequired = fieldName & "が未入力です"
    Else
        CheckRequired = ""
    End If
End Function

' 数値チェック（小数OK）
Function CheckNumber(ByVal value As Variant, ByVal fieldName As String) As String
    Dim s As String
    s = Trim(CStr(value))
    If s = "" Then
        CheckNumber = "" ' 必須かどうかは別で判定
        Exit Function
    End If
    If Not IsNumeric(s) Then
        CheckNumber = fieldName & "は数値で入力してください"
    Else
        CheckNumber = ""
    End If
End Function

' 整数チェック（負数・ゼロ可）
Function CheckInteger(ByVal value As Variant, ByVal fieldName As String) As String
    Dim s As String
    s = Trim(CStr(value))
    If s = "" Then
        CheckInteger = "" ' 必須かどうかは別で判定
        Exit Function
    End If
    If Not IsNumeric(s) Then
        CheckInteger = fieldName & "は整数で入力してください"
        Exit Function
    End If
    If CLng(CDec(s)) <> CDec(s) Then
        CheckInteger = fieldName & "は整数で入力してください"
    Else
        CheckInteger = ""
    End If
End Function

' 数値の範囲チェック（最小・最大は省略可）
Function CheckNumberRange(ByVal value As Variant, ByVal fieldName As String, _
                          Optional ByVal minVal As Variant, Optional ByVal maxVal As Variant) As String
    Dim s As String
    s = Trim(CStr(value))
    If s = "" Then
        CheckNumberRange = "" ' 必須は別で
        Exit Function
    End If
    If Not IsNumeric(s) Then
        CheckNumberRange = fieldName & "は数値で入力してください"
        Exit Function
    End If
    Dim n As Double
    n = CDbl(s)
    If Not IsMissing(minVal) Then
        If n < CDbl(minVal) Then
            CheckNumberRange = fieldName & "は" & minVal & "以上で入力してください"
            Exit Function
        End If
    End If
    If Not IsMissing(maxVal) Then
        If n > CDbl(maxVal) Then
            CheckNumberRange = fieldName & "は" & maxVal & "以下で入力してください"
            Exit Function
        End If
    End If
    CheckNumberRange = ""
End Function

'--- 日付チェック ---

' 日付形式チェック（1900日付シリアルも許容）
Function CheckDate(ByVal value As Variant, ByVal fieldName As String) As String
    If IsDate(value) Then
        CheckDate = ""
    Else
        Dim s As String
        s = Trim(CStr(value))
        If s = "" Then
            CheckDate = "" ' 必須は別
        Else
            CheckDate = fieldName & "は日付で入力してください（例：2025/10/17）"
        End If
    End If
End Function

' 日付の範囲チェック（最小・最大は省略可）
Function CheckDateRange(ByVal value As Variant, ByVal fieldName As String, _
                        Optional ByVal minDate As Variant, Optional ByVal maxDate As Variant) As String
    If Trim(CStr(value)) = "" Then
        CheckDateRange = "" ' 必須は別
        Exit Function
    End If
    If Not IsDate(value) Then
        CheckDateRange = fieldName & "は日付で入力してください"
        Exit Function
    End If
    Dim d As Date
    d = CDate(value)
    If Not IsMissing(minDate) Then
        If d < CDate(minDate) Then
            CheckDateRange = fieldName & "は" & Format(CDate(minDate), "yyyy/mm/dd") & "以降で入力してください"
            Exit Function
        End If
    End If
    If Not IsMissing(maxDate) Then
        If d > CDate(maxDate) Then
            CheckDateRange = fieldName & "は" & Format(CDate(maxDate), "yyyy/mm/dd") & "以前で入力してください"
            Exit Function
        End If
    End If
    CheckDateRange = ""
End Function

'--- 文字列チェック ---

' 最大文字数チェック（全角・半角ともに文字数としてカウント）
Function CheckMaxLength(ByVal value As Variant, ByVal fieldName As String, ByVal maxLen As Long) As String
    Dim s As String
    s = CStr(value)
    If Len(s) > maxLen Then
        CheckMaxLength = fieldName & "は" & maxLen & "文字以内で入力してください"
    Else
        CheckMaxLength = ""
    End If
End Function

' 正規表現チェック（VBScript.RegExpを使用）
Function CheckRegex(ByVal value As Variant, ByVal fieldName As String, ByVal pattern As String, _
                    Optional ByVal hint As String = "") As String
    Dim s As String
    s = Trim(CStr(value))
    If s = "" Then
        CheckRegex = "" ' 必須は別
        Exit Function
    End If
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = pattern
    re.IgnoreCase = True
    re.Global = False
    If re.Test(s) Then
        CheckRegex = ""
    Else
        If hint <> "" Then
            CheckRegex = fieldName & "の形式が不正です（" & hint & "）"
        Else
            CheckRegex = fieldName & "の形式が不正です"
        End If
    End If
End Function

'--- エラーメッセージ集約 ---

' エラーを配列で返すヘルパー
Function CollectErrors(ParamArray messages() As Variant) As Variant
    Dim i As Long, count As Long
    ' まず件数カウント
    For i = LBound(messages) To UBound(messages)
        If CStr(messages(i)) <> "" Then count = count + 1
    Next i
    If count = 0 Then
        CollectErrors = Array()
        Exit Function
    End If
    Dim result() As String
    ReDim result(0 To count - 1)
    Dim idx As Long
    For i = LBound(messages) To UBound(messages)
        If CStr(messages(i)) <> "" Then
            result(idx) = CStr(messages(i))
            idx = idx + 1
        End If
    Next i
    CollectErrors = result
End Function

' エラー配列を改行で結合
Function JoinErrors(ByVal errors As Variant) As String
    If IsEmpty(errors) Then
        JoinErrors = ""
        Exit Function
    End If
    On Error Resume Next
    JoinErrors = Join(errors, vbCrLf)
End Function
VB

呼び出し例（行単位の一括検証）

Sub ValidateRowSample()
    Dim ws As Worksheet
    Dim row As Long
    Dim errs As Variant
    Dim msg As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    row = 2 ' 検証したい行
    
    errs = CollectErrors( _
        CheckRequired(ws.Cells(row, "A").Value, "氏名"), _
        CheckMaxLength(ws.Cells(row, "A").Value, "氏名", 50), _
        CheckRequired(ws.Cells(row, "B").Value, "年齢"), _
        CheckInteger(ws.Cells(row, "B").Value, "年齢"), _
        CheckNumberRange(ws.Cells(row, "B").Value, "年齢", 0, 120), _
        CheckRequired(ws.Cells(row, "C").Value, "入社日"), _
        CheckDate(ws.Cells(row, "C").Value, "入社日"), _
        CheckDateRange(ws.Cells(row, "C").Value, "入社日", #1/1/1990#, Date), _
        CheckRegex(ws.Cells(row, "D").Value, "メール", "^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,}$", "例：name@example.com") _
    )
    
    msg = JoinErrors(errs)
    If msg <> "" Then
        MsgBox "入力エラーがあります:" & vbCrLf & msg, vbExclamation, "検証結果"
    Else
        MsgBox "この行は正しく入力されています。", vbInformation, "検証結果"
    End If
End Sub
VB

シート全体を検証して結果を一覧化

Sub ValidateSheetSummary()
    Dim ws As Worksheet, report As Worksheet
    Dim lastRow As Long, r As Long, output As Long
    Dim errs As Variant, msg As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' レポートシート用意
    On Error Resume Next
    Set report = ThisWorkbook.Sheets("検証結果")
    On Error GoTo 0
    If report Is Nothing Then
        Set report = ThisWorkbook.Sheets.Add
        report.Name = "検証結果"
    Else
        report.Cells.Clear
    End If
    
    report.Range("A1").Value = "行番号"
    report.Range("B1").Value = "氏名"
    report.Range("C1").Value = "エラー内容"
    output = 2
    
    For r = 2 To lastRow
        errs = CollectErrors( _
            CheckRequired(ws.Cells(r, "A").Value, "氏名"), _
            CheckMaxLength(ws.Cells(r, "A").Value, "氏名", 50), _
            CheckRequired(ws.Cells(r, "B").Value, "年齢"), _
            CheckInteger(ws.Cells(r, "B").Value, "年齢"), _
            CheckNumberRange(ws.Cells(r, "B").Value, "年齢", 0, 120), _
            CheckRequired(ws.Cells(r, "C").Value, "入社日"), _
            CheckDate(ws.Cells(r, "C").Value, "入社日"), _
            CheckDateRange(ws.Cells(r, "C").Value, "入社日", #1/1/1990#, Date) _
        )
        msg = JoinErrors(errs)
        If msg <> "" Then
            report.Cells(output, "A").Value = r
            report.Cells(output, "B").Value = ws.Cells(r, "A").Value
            report.Cells(output, "C").Value = msg
            report.Cells(output, "C").WrapText = True
            output = output + 1
        End If
    Next r
    
    MsgBox "検証が完了しました。エラー行数: " & (output - 2), vbInformation
End Sub
VB

運用のコツ

  • 必須と形式は分離: 必須は CheckRequired、形式は CheckNumber/CheckDate で独立させると再利用性が上がる。
  • メッセージの統一: 文言をこのモジュールで統一するとユーザー体験が整う。
  • フィールド定義化: 項目名・必須・型・範囲を別モジュールや定義表に持たせると、メンテしやすい。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
@lifehacker
スポンサーリンク
タイトルとURLをコピーしました