20200105_Excelの日付入力時に年末年始の時期だけ年数を書き換えるイベントマクロ

Sheet.vba

Option Explicit

'Excelの日付入力時に年末年始の時期だけ年数を書き換えるイベントマクロ

'基本方針
' 1. Excelではセルにmm/dd形式で入力した時に今年が自動補完されるが、
'     今月が1月で入力が12月の場合､前年に戻す
'     今月が12月で入力が1月の場合､来年に進む
'   という自動補完に変更する。
'
' 2.「元に戻す」を破壊しない。
'    普通に.Valueを書き換えると「元に戻す」が使えなくなるので採用しない。
'
' 3. 副作用を起こさない。
'    様々な入力状況が考えられるが、できるだけ意図せぬ動作をしないようにする。

'注意
' このVBAは「ネタ」です。
'
' 書式設定は「標準」が設定されているものとする。
' 下記の例では全てのセルが対象となっているが、本番では絞ったほうが安全である。
' 環境によってはDoEventsを適度に挿入しないと安定しないかもしれない。
' このマクロはシートモジュールに記載する。
' 広範囲に適用させるにはブックモジュールやクラスモジュール用に書き換えると良い。
'
' このVBAは「ネタ」です。使用は推奨しません。

Private Sub Worksheet_Change(ByVal Target As Range)

    '複数セルの同時編集には対応していない
    If Target.CountLarge > 1 Then Exit Sub
    
    Dim rng     As Range
    Dim v       As Variant
    Dim addYear As Long
    
    '複数セルに対応させていないので、実はこのForは無意味
    For Each rng In Target.Cells
        v = rng.Value
        
        '「標準」の状態で日付をmm/dd表記で入力すると書式が「m"月"d"日"」になる性質を利用する
        If (rng.NumberFormatLocal Like "*年*") And rng.NumberFormatLocal Like "*月*" Then GoTo ContinueFor
        If Not IsDate(v) Then GoTo ContinueFor
        
        '今月が1月で入力が12月の場合、前年に戻す
        If Month(v) = 12 And Month(Now()) = 1 And Year(v) = Year(Now()) Then
            addYear = -1
        '今月が12月で入力が1月の場合、来年に進む
        ElseIf Month(v) = 1 And Month(Now()) = 12 And Year(v) = Year(Now()) Then
            addYear = 1
        Else
            addYear = 0
        End If
        
        If addYear <> 0 Then
'        Debug.Print rng.Address(False, False)
            rng.Select
            
            '「元に戻す」履歴からこの日付入力を取り消し
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
            
            'ココで修飾キーを一旦無効化しないとCtrl+Enter、Ctrl+Zされた場合などに問題が。
            SendKeys "+^%"
            
            '補完済年号で入力
            SendKeys Format(DateSerial(Year(v) + addYear, Month(v), Day(v)), "yyyy-m-d")
            SendKeys "~"
        End If
        
ContinueFor:
    Next
    
End Sub

関連ツイート

はけた氏のツイート

ことりちゅんの別案