VBA 面倒な日付入力を超ラクにするアイデア ～明日(++)、3日前(-3)、再来週の月曜日(++ge)、先月末(-gm)などの短縮入力に対応

システムで日付を入力するシチュエーションがある。

たとえばこういうやつ。

これが結構面倒くさい。

人間同士の会話なら、単に「とおか」と言えばふつう今月の10日を指す。
あるいは、「先週の火曜日」とか、「今月末」といった表現もよく使う。

しかしコンピューターに対してはいちいち"2015/11/07"とフル入力しないといけないケースがほとんどで、なんて融通が利かない奴なんだとイライラすることも多い。

そこで、できるだけ人間の感覚で楽々入力できるような関数を作成してみた。

仕様はこんな感じ。

• まず何も入力しないか、0を入力すると、「今日」と見なす。
• ++と入力すれば「明日」、--と入力すれば「昨日」と見なす。
• +か-に続けて数値Xを入力すると、「X日後」、「X日前」と見なす。
• 1～2桁の数値dを入力すると、「今月のd日」と見なす。
• 4桁の数値mmddを入力すると、「今年のmm月dd日」と見なす。
• 曜日のローマ字の先頭2文字xxを入力すると、今週のxx曜日と見なす。

凡例

■年月日指定
yyyy/mm/dd…yy年mm月dd日
yyyy/m/d…yy年m月d日
yyyymmdd…yyyy年mm月dd日
yymmdd…yy年mm月dd日
mmdd…mm月dd日
m/d…m月d日
dd…今月dd日
d…今月d日

■当日指定
""…今日
"0"…今日

■インクリメント/デクリメント
"++"…明日
"--"…昨日

■加減指定
"+1"…明日
"+2"…明後日
"+3"…明々後日
"-1"…昨日
"-2"…一昨日
"-3"…先一昨日

■月末指定
"gm"…今月末
"+gm"…来月末
"-gm"…先月末
"2015/6/gm"…2015年6月末
"12gm"…今年の12月末
"201302gm"…2013年の2月末
"0407gm"…2004年の7月末

■曜日指定
"ni"…今週日曜
"ge"…今週月曜
"ka"…今週火曜
"su"…今週水曜
"mo"…今週木曜
"ki"…今週金曜
"do"…今週土曜

"+ni"…来週日曜
"++ni"…再来週の日曜
"-ni"…先週の日曜
"--ni"…先々週の日曜

コード

VBAの関数コードはこちら。
標準モジュールに張り付けて、Subプロシージャ等から呼び出して使う。
特に参照設定などは不要である。

このLazyDate関数に日付を表す文字列を渡すと、ちゃんとした日付型のデータが返ってくる。

Function LazyDate(ByVal DateString As String) As Date
    Dim ret As Date
    DateString = Trim(DateString)
    
    '固定文字列判定
    Select Case DateString
    Case "", "0"
        ret = Date: GoTo FIN
    Case "++"
        ret = Date + 1: GoTo FIN
    Case "--"
        ret = Date - 1: GoTo FIN
    End Select
    
    Dim RE As Object
    Set RE = CreateObject("VBScript.RegExp")
    '符号と数値での指定
    RE.Pattern = "^(\+|\-)\d+$"
    If RE.test(DateString) Then
        ret = Date + CInt(DateString): GoTo FIN
    End If
    
    '正規表現による符号+英2文字指定
    RE.Pattern = "^(\+|\-)*[a-z]{2}$"
    If RE.test(DateString) Then
        RE.Pattern = "[a-z]{2}"
        Dim MatchString As String
        MatchString = RE.Execute(DateString).Item(0)

        'xは符号とその数
        Dim x As Integer: x = Len(DateString) - 2
        If Left(DateString, 1) = "-" Then x = x * -1
            
        '月末指定
        If MatchString = "gm" Then
            ret = CDate(Format(DateAdd("m", 1 + x, Date), "yyyy/mm/01")) - 1
            GoTo FIN
        End If
        
        ret = DateAdd("ww", x, Date - Weekday(Date) + 1)
        Select Case MatchString
        Case "ni"
            GoTo FIN
        Case "ge"
            ret = ret + 1: GoTo FIN
        Case "ka"
            ret = ret + 2: GoTo FIN
        Case "su"
            ret = ret + 3: GoTo FIN
        Case "mo"
            ret = ret + 4: GoTo FIN
        Case "ki"
            ret = ret + 5: GoTo FIN
        Case "do"
            ret = ret + 6: GoTo FIN
        End Select
    End If
    
    '月末表記(gm)が末尾にある場合は、一旦01に変更して日付変換をトライ
    Dim gmFlag As Boolean
    gmFlag = (Right(DateString, 2) = "gm")
    DateString = Replace(DateString, "gm", "01")

    If IsDate(DateString) Then
        ret = CDate(DateString)
        If gmFlag Then ret = DateAdd("m", 1, ret) - 1
        GoTo FIN
    End If
    
    Select Case Len(DateString)
    Case 1 To 2
        DateString = Format(Date, "yyyy/mm/") & DateString
    Case 4
        DateString = Format(Date, "yyyy/") & Left(DateString, 2) & "/" & Right(DateString, 2)
    Case 6
        DateString = Left(DateString, 2) & "/" & Mid(DateString, 3, 2) & "/" & Right(DateString, 2)
    Case 8
        DateString = Left(DateString, 4) & "/" & Mid(DateString, 5, 2) & "/" & Right(DateString, 2)
    End Select

    '更新したDateStringを改めて判定
    If IsDate(DateString) Then
        ret = CDate(DateString)
        If gmFlag Then ret = DateAdd("m", 1, ret) - 1
    Else
        'どれもヒットしない場合は当日の日付を返す。
        ret = Date
    End If

FIN:
    LazyDate = ret
End Function

実際にこの関数を呼び出しているサンプルコード。

Sub test()
    Dim x As String
    x = InputBox("日付を入力してください。")
    MsgBox LazyDate(x)
End Sub

例えば、先週の火曜日を入力したいときは、-kaと入力する。
先々々々々々々週の木曜なら、-------moと入力する。
来々々々々々々週の金曜なら、+++++++kiと入力する。
再来月の末日なら、++gmである。

コード例ではInputBoxで使用しているが、関数なのでユーザーフォームにも利用できる。
これで個人的にはすごく直感的に入力できるようになった。
自分で作ったので多少のひいきは入っているかもしれないが、超絶便利なのでVBA使いの方はぜひ一度使ってみてほしい。