ExcelVBAで「値なし」の判定を集めたもの

動作環境

• Windows 7/10
• Excel(Office) 2010/2016で確認

（一部Excel特有の判定もあるので、Access VBA等で確認の際はIsError等の判定をコメントアウトしてください）

主な機能

• あらゆる値(Variant型)に値が無いことを確認できる
• 応用として、InputBoxの入力判定（キャンセル、空欄のままOK）に対応
• 値なし時のエラーメッセージの出力（指定無しならMsgBox表示, メッセージ指定可能）
• 有効日付の判定も行える(DateUtil.basにて)

補足

• 近日中にGitHubに投稿予定
• コメントでの説明が不足している（特にDateUtil.bas）ので、GitHubに正式版を投稿した際に更新します。

サンプルコード

今回のメイン（共通関数）

Common.bas

' 入力値の判定(IsNoValueで結果を判定)
Public Function GetInputValue(ByRef val As Variant, _
        ByVal promptStr As String, ByVal errMsgStr As String, _
        ByVal defaultValue As Variant) As Boolean
    val = InputBox(promptStr)
    GetInputValue = Not IsNoValue(val, errMsgStr)

    If GetInputValue = False Then
        val = defaultValue
    End If
End Function

' 今回のメイン機能（値なしの判定を並べたもの）
Public Function IsNoValue(ByRef val As Variant, _
        Optional ByVal errMsgStr As String = "無効な値です", _
        Optional ByVal viewMsg As Boolean = True) As Boolean
    On Error GoTo Err
    Dim dateStr As String
    Call PrintValueInfo(val)

    IsNoValue = False

    If VarType(val) = vbString Then
        IsNoValue = False

        'InputBox空欄OK時, str = ""(NG)
        '値のある文字列なら
        If val = "" Or Len(val) = 0 Then    
            IsNoValue = True
        End If
    '(NG) TypeName="Nothing"で判定（本当にNothingだとIs Nothingでは判定不可）
    ElseIf IsNothing(val) Then  
        IsNoValue = True
    ElseIf IsEmpty(val) Then    '初期化されていない値(NG)
        IsNoValue = True
    ElseIf IsMissing(val) Then  'Optional変数で値がないとき（空文字を入れる）(NG)
        val = ""
        IsNoValue = True
    ElseIf IsError(val) Then    'エラー値のとき（空文字を入れる）(NG)
        val = ""
        IsNoValue = True
    ElseIf IsNumeric(val) Then  '数値(OK)
        IsNoValue = False
    ElseIf IsDate(val) Then     '日付データのとき(OK)
        val = CDate(val)
        IsNoValue = False
    ElseIf StrPtr(val) = 0 Then 'InputBoxキャンセル時(NG)
        IsNoValue = True
    ElseIf IsNull(val) Then     'オブジェクトが空
        IsNoValue = True
    ElseIf val = "" Then        'InputBox空欄OK時, str = ""
        IsNoValue = True
    ElseIf Len(val) = 0 Then    '空文字列
        IsNoValue = True
    End If

    If IsNoValue = False Then
        '有効な日付か判定
        If IsDate(val) = False Then
            dateStr = CStr(val)
            If IsDateStr(dateStr) = True Then
                val = CDate(dateStr)
            End If
        End If
    ElseIf IsArray(val) Then
        Debug.Print "Array: Len(" & UBound(val) & ")"
    ElseIf viewMsg = True Then
        MsgBox errMsgStr
    End If
    Call PrintValueInfo(val, IsNoValue)
    Exit Function
Err:
    IsNoValue = True
    Call PrintValueInfo(val, IsNoValue)
    MsgBox errMsgStr & vbCrLf & Err.Number & ": " & Err.Description
End Function

' TypeNameでIs Nothing判定
Public Function IsNothing(ByVal objvar As Variant) As Boolean
    IsNothing = (TypeName(objvar) = "Nothing")
End Function

' デバッグ用
Private Sub PrintValueInfo(ByVal val As Variant, Optional ByVal result As String = "")
    Dim valStr As String
    If IsNothing(val) Then
        valStr = ""
    Else
        valStr = CStr(val)
    End If

    If Len(valStr) > 29 Then
        valStr = Left(valStr, 29) & "..."
    End If

    Debug.Print "TypeName(val): " & TypeName(val) & " = " & _
                    IIf(TypeName(val) = "Nothing", "Nothing", valStr) & _
                    IIf(result = "", "", "(" & result & ")")
End Sub

補助関数として、日付の汎用関数

※一部抜粋したものです（今後改良予定）

DateUtil.bas

Public Function IsDateStr(ByRef dateStr As String, Optional askConv As Boolean = True) As Boolean
    On Error GoTo Err
    Dim formatStr As String
    Dim HasColon As Boolean, HasSlash As Boolean
    IsDateStr = False
    formatStr = ""

    HasColon = InStr(1, dateStr, DATE_COLON) > 0
    HasSlash = InStr(1, dateStr, DATE_SLASH) > 0

    dateStr = Replace(dateStr, DATE_SLASH, "")
    dateStr = Replace(dateStr, DATE_COLON, "")
    dateStr = Replace(dateStr, " ", "")

    If IsNumeric(dateStr) Then
        Select Case Len(dateStr)
            Case 8
                formatStr = "@@@@/@@/@@"
            Case 13
                formatStr = "@@@@/@@/@@ @:@@:@@"
            Case 14
                formatStr = "@@@@/@@/@@ @@:@@:@@"
            Case 5
                If HasColon Then
                    formatStr = "@:@@:@@"
                Else
                    GoTo Err
                End If
            Case 6
                If HasSlash Then
                    formatStr = "@@@@/@@"
                ElseIf HasColon Then
                    formatStr = "@@:@@:@@"
                Else
                    formatStr = "@@@@/@@"
                End If
            Case Else
                GoTo Err
        End Select

        Debug.Print "formatStr: " & formatStr
        If askConv = False Then
            dateStr = format(dateStr, formatStr)
            Debug.Print "dateStr: " & dateStr
            IsDateStr = True

            Exit Function
        ElseIf MsgBox("日付型に変換しますか？", vbYesNo) = vbYes Then
            dateStr = format(dateStr, formatStr)
            Debug.Print "dateStr: " & dateStr
            IsDateStr = True

            Exit Function
        End If
    End If
    Exit Function
Err:

End Function