Excel 2010 VBAで使用する［IsDate］関数は与えられた文字列が日付形式かどうかを返してくれる関数です。
通常は問題ないのですが、先日変な現象に遭遇しました。
下記のプログラムを見てください。
Public Function test_IsDate(buf As Variant) As Variant
test_IsDate = IIf(IsDate(buf), "[" & buf & "］は日付です。", _
"[" & buf & "］は日付ではありません。")
End Function
Public Sub test()
MsgBox "1." & test_IsDate("2011/11/30") & vbCrLf _
& "2." & test_IsDate("2011/11") & vbCrLf _
& "3." & test_IsDate("11/3") & vbCrLf _
& "4." & test_IsDate("12/32") & vbCrLf _
& "5." & test_IsDate("00A") & vbCrLf _
& "6." & test_IsDate("00") & vbCrLf _
& "7." & test_IsDate("0A") & vbCrLf _
& "8." & test_IsDate("A") & vbCrLf _
, vbOKOnly + vbInformation, "IsDateテスト"
End Sub
どんな結果になるか、想像できますよね、
ｔｅｓｔを実行した結果は下図の通り。想像した結果と違っていたのではないでしょうか？
4.5.7.はどう見たっておかしいですよね。 原因についてはわかりませんが、日付ではない一般の文字列を渡すことは避けたほうがいいようです。
というわけで、自前のMyIsDateプロシージャを作ってみました。 （ http://kozhouse.homeip.net/progtec/11/ を参考にさせて頂きました。)
Public Sub test2()
MsgBox "1." & test_MyIsdate("2011/11/30") & vbCrLf _
& "2." & test_MyIsdate("2011/11") & vbCrLf _
& "3." & test_MyIsdate("11/3") & vbCrLf _
& "4." & test_MyIsdate("12/32") & vbCrLf _
& "5." & test_MyIsdate("00A") & vbCrLf _
& "6." & test_MyIsdate("00") & vbCrLf _
& "7." & test_MyIsdate("0A") & vbCrLf _
& "8." & test_MyIsdate("A") & vbCrLf _
& "9." & test_MyIsdate("2011/11/30 12:34:56") & vbCrLf _
& "10." & test_MyIsdate("11/30 12:34:56") & vbCrLf _
& "11." & test_MyIsdate("2011/11 12:34:61") & vbCrLf _
& "12." & test_MyIsdate("11/30 12:34:61") & vbCrLf _
, vbOKOnly + vbInformation, "MyIsDateテスト"
End Sub
Private Function test_MyIsdate(buf As Variant) As Variant
test_MyIsdate = IIf(MyIsDate(buf), "[" & buf & "］は日付です。", _
"[" & buf & "］は日付ではありません。")
End Function
Public Function MyIsNumeric(chkStr As Variant) As Boolean
Dim ii As Integer
MyIsNumeric = True
For ii = 1 To Len(chkStr)
If InStr(1, "0123456789", Mid(chkStr, ii, 1), vbTextCompare) = 0 Then
MyIsNumeric = False
Exit For
End If
Next ii
End Function
Public Function MyIsDate(targetDate As Variant) As Boolean
Dim sYear As Variant
Dim sMonth As Variant
Dim sDay As Variant
Dim nYear As Long
Dim nMonth As Long
Dim nDay As Long
Dim nDayMax As Long
Dim ii As Long
Dim jj As Long
Dim cntr As Long
Dim pos(1 To 2) As Long
Dim sHour As Variant
Dim sMin As Variant
Dim sSec As Variant
Dim nHour As Long
Dim nMin As Long
Dim nSec As Long
Dim cntrH As Long
Dim tmp As Variant
Dim bufHour As Variant
Dim posh(1 To 2) As Long
MyIsDate = False
cntr = 0 '区切り記号 / の数
For ii = 1 To Len(targetDate)
If Mid(targetDate, ii, 1) = "/" Then
cntr = cntr + 1
If cntr > 2 Then
Exit Function 'ふたつ以上の時は不正
End If
pos(cntr) = ii
End If
Next ii
If cntr = 0 Then ' / が無いときは不正
Exit Function
End If
'これ以降 / のかずは、1または2個
sYear = Left(targetDate, pos(1) - 1)
Select Case cntr
Case 2 '年/月/日
sMonth = Mid(targetDate, pos(1) + 1, pos(2) - pos(1) - 1)
sDay = Mid(targetDate, pos(2) + 1)
Case 1 '年/月
sMonth = Mid(targetDate, pos(1) + 1)
Case 0
Exit Function
End Select
If Not MyIsNumeric(sYear) Then
Exit Function
Else
nYear = CLng(sYear)
End If
If Not MyIsNumeric(sMonth) Then
Exit Function
'yyyy/mm hh:nn:ss はNG ← 日 が無い
'mm/dd hh:nn:ss はNG ← 年 が無い
Else
nMonth = CLng(sMonth)
End If
If cntr = 2 Then ' 年/月/日 ***
If Not MyIsNumeric(sDay) Then
tmp = Split(sDay, " ", , vbTextCompare)
sDay = tmp(0) 'yyyy/mm/dd hh:nn:ss はok
If Not MyIsNumeric(sDay) Then
Exit Function
Else
nDay = CLng(sDay)
End If
If UBound(tmp) > 1 Then
Exit Function
Else 'yyyy/mm/dd ［］
bufHour = tmp(1) 'hh:nn:ss でないときはNG
cntr = 0 '区切り記号 : の数
For jj = 1 To Len(bufHour)
If Mid(bufHour, jj, 1) = ":" Then
cntrH = cntrH + 1
If cntrH > 2 Then
Exit Function
End If
posh(cntrH) = jj
End If
Next jj
If cntrH <> 2 Then
Exit Function
End If
sHour = Left(bufHour, posh(1) - 1)
sMin = Mid(bufHour, posh(1) + 1, posh(2) - posh(1) - 1)
sSec = Mid(bufHour, posh(2) + 1)
If Not MyIsNumeric(sHour) Then
Exit Function
Else
nHour = CLng(sHour)
End If
If Not MyIsNumeric(sMin) Then
Exit Function
Else
nMin = CLng(sMin)
End If
If Not MyIsNumeric(sSec) Then
Exit Function '-5
Else
nSec = CLng(sSec)
End If
If Not (nHour >= 0 And nHour < 24) Then
Exit Function
End If
If Not (nMin >= 0 And nMin < 60) Then
Exit Function
End If
If Not (nSec >= 0 And nSec < 60) Then
Exit Function
End If
End If
Else
nDay = CLng(sDay)
End If
End If
Select Case nMonth
Case 1, 3, 5, 7, 8, 10, 12
nDayMax = 31
Case 4, 6, 9, 11
nDayMax = 30
Case 2
nDayMax = 28 - ((nYear Mod 400) = 0) + ((nYear Mod 100) = 0) - ((nYear Mod 4) = 0)
Case Else
Exit Function
End Select
If cntr = 2 Then '年/月/日
If (nDay >= 1) And (nDay <= nDayMax) Then
MyIsDate = True
End If
Else
MyIsDate = True
End If
End Function
仕様的には、
基本形 年/月/日 時:分:秒
OK 年/月/日
OK 月/日
OK 年/月/日 時:分:秒
NG 年/月 時:分:秒
NG 月/日 時:分:秒 ← 少し拡張すれば、OKになるようにできると思います
実行結果は下図の通りです。
