itcore TOP ＞ TIPS ＞ vba_date.php 　タグ:vba 日付チェック

VBA 日付のチェックと正規化 | itcore 2019年

ソース　ExcelよりALT+F11で貼り付ける

Option Explicit
'-------------------------------
' 日付のチェックと正規化　関数
'-------------------------------
Function conv_date(date1)
  conv_date = "" ' 日付が異常なときは空を返す。
  Dim s1, s2, i, data, yyyy, mm, dd
  ' 数字とセパレータ以外を削除
  s2 = ""
  For i = 1 To Len(date1)
    s1 = Mid(date1, i, 1)
    If "-" = s1 Then s1 = "/" ' セパレータを統一
    If 0 < InStr("0123456789/", s1) Then
      s2 = s2 + s1
    End If
  Next i
  ' セパレータがあったら分解
  If 0 < InStr(s2, "/") Then
    data = Split(s2 & "//", "/")
    yyyy = Trim(data(0))
    If 4 <> Len(yyyy) Then Exit Function
    mm = Trim(data(1))
    If 1 = Len(mm) Then mm = "0" & mm
    If 2 <> Len(mm) Then Exit Function
    dd = Trim(data(2))
    If 1 = Len(dd) Then dd = "0" & dd
    If 2 <> Len(dd) Then Exit Function
  Else
    If 8 <> Len(s2) Then Exit Function
    yyyy = Left(s2, 4)
    mm = Mid(s2, 5, 2)
    dd = Right(s2, 2)
  End If

  If 1000 > Val(yyyy) Or 3000 < Val(yyyy) Then Exit Function
  If 1 > Val(mm) Or 12 < Val(mm) Then Exit Function
    Dim dd_max: dd_max = 31
  If 0 < InStr("04 06 09 11", mm) Then
    dd_max = 30
  ElseIf "02" = mm Then
    dd_max = 28
    If 0 = (yyyy Mod 4) Then
      dd_max = 29
      If 0 = (yyyy Mod 100) Then
        dd_max = 28
        If 0 = (yyyy Mod 400) Then
          dd_max = 29
        End If
      End If
    End If
  End If
  If 1 > Val(dd) Or Val(dd_max) < Val(dd) Then Exit Function

  conv_date = yyyy & mm & dd
End Function

'---------------------------
' テスト関数
'---------------------------
sub test1(date1)
  debug.print date1 & " => " & conv_date(date1)
end sub
'---------------------------
' テスト実行
'---------------------------
sub main
  test1("2019/09/26")
  test1("2019/9/26")
  test1("20190926")
  test1("2019/09/31")
  test1("2020/02/29")
  test1("2100/02/29")
  test1("2400/02/29")
end sub

実行結果

2019/09/26 => 20190926
2019/09/26 => 20190926
2019/9/26 => 20190926
20190926 => 20190926
2019/09/31 =>
2020/02/29 => 20200229
2100/02/29 =>
2400/02/29 => 24000229