#動作環境
- 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