2
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2017-03-09

#動作環境

  • 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
2
3
2

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
2
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?