VBA/エクセルの日付入力でYYYYMMDD

質問

エクセル2013です。
特定のセルに日付を入力してもらうのですが、人によりさまざまな入力をされてしまいます。
どんな入力でも日付であれば、シリアル値なのであとからなんとかなるのですが、困るのはYYYYMMDDの連続数字、例えば今日なら20140712と入力されてしまうことです。
入力規則で排除したいのですが、それは許されず、20140712も日付として扱わなければならなくなりそうです。
そこでマクロで対処しようと以下のコードを書きました。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Select Case Target.Address(0, 0)
　　　　Case "D2", "F2", "C4"
　　　　　　If Target.Value = "" Then Exit Sub
　　　　　　If IsDate(Target.Value) Then
　　　　　　　　Target.NumberFormatLocal = "yyyy/m/d"
　　　　　　Else
　　　　　　　　Application.EnableEvents = False
　　　　　　　　Target.Value = CDate(Format(Target.Value, "@@@@/@@/@@"))
　　　　　　　　Application.EnableEvents = True
　　　　　　End If
　　　　Case Else
　　　　　　Exit Sub
　　End Select
End Sub

これで最初はうまくいき、20140712と入力されても、ちゃんと2014/7/12になります。
ところが、同じセルに再度YYYYMMDD数字形式で入力すると、実行時エラー「オーバーフローしました」になってしまいます。多分セルが、YYYYMMDDの数字をシリアル値として見てありえない日付と判断したのだと思います。
どのようにコードを修正したらよろしいでしょうか？

もう1点、日付をYYYYMMDDの連続数字で入力することは普通、エクセルではあまり見たことないですが、これって一般的な方法なのでしょうか？

回答No.8

tom04 · ベストアンサー

No.3・6です。
たびたびごめんなさい。

No.7さんのご指摘は判っていたのですが、分岐が面倒なのでスルーしていました。
今度は色々な入力間違いを考慮してみました。
（うるう年・大の月小の月等）
尚、2000年は100年に一度のうるう年でない年なのですが、この100年に一度は考慮していません。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Integer, myY As Integer, myM As Integer, myD As Integer, myFlg As Boolean, myArry
If Intersect(Target, Range("D2,F2,C4")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
.NumberFormatLocal = "G/標準"
On Error GoTo 1
If IsNumeric(.Value) And Len(.Value) = 8 Then
myY = Left(.Value, 4)
myM = Mid(.Value, 5, 2)
myD = Right(.Value, 2)
myArry = Array(3, 5, 7, 8, 10, 12)
For k = 0 To UBound(myArry)
If myM = myArry(k) Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
If myD > 31 Then
GoTo 1
End If
Else
If myM = 2 Then
If myY Mod 4 = 0 Then
If myD > 29 Then
GoTo 1
Exit Sub
End If
Else
If myD > 28 Then
GoTo 1
Exit Sub
End If
End If
Else
If myD > 30 Then
GoTo 1
End If
End If
End If
Application.EnableEvents = False
.Value = DateSerial(myY, myM, myD)
Application.EnableEvents = True
Else
If Year(.Value) < 2100 Then
.NumberFormatLocal = "yyyy/m/d"
Else
GoTo 1
Exit Sub
End If
End If
Exit Sub
1: MsgBox "入力値が不正です"
.Select
Exit Sub
End With
End Sub

※　細かい検証はしていませんので、間違いがあったらごめんなさいね。m(_ _)m

お礼

tom04 さん、なんどもありがとうございます。
いろいろ検討した結果、tom04 さんに最初に教えていただいたコードをベースに以下のようにしてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pw As String
pw = "password"
If Intersect(Target, Range("D2,F2,C4")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
Me.Protect Password:=pw, UserInterfaceOnly:=True
Application.ScreenUpdating = False
.NumberFormatLocal = "G/標準"
On Error GoTo line
If .Value <> "" Then
If IsNumeric(.Value) And Len(.Value) = 8 Then
Application.EnableEvents = False
.Value = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2)
End If
.NumberFormatLocal = "yyyy/m/d"
Application.ScreenUpdating = True
If Not IsDate(.Value) Then
MsgBox "日付を認識できません。", vbCritical
ElseIf .Value >= "2100/01/01" Or .Value <= "1910/12/31" Then
MsgBox "対象外の日付です。", vbCritical
End If
End If
End With
line:
Application.ScreenUpdating = True
Application.EnableEvents = True
Me.Protect Password:=pw, UserInterfaceOnly:=False
End Sub

さいわい、入力させる日付の範囲が限定できるので、これでほとんど対応できると思います。
ありがとうございました。

補足

せっかく、いろんなエラー対策を考えていただいたのにごめんなさい。

回答No.15

cj_mover

失礼、訂正です。
誤）
その上で＃８についてアドバイスを送るとすると、
正）
その上で＃８お礼欄のコードについてアドバイスを送るとすると、
以上、失礼しました。

お礼

ご丁寧にありがとうございました。

回答No.14

cj_mover

＃１２-１３、ｃｊです。＃１２お礼欄へのレスです。

> ただ今回は、コピペ入力や時間まで入るケースは想定しなくてよいので、もっと簡単（というか、後任者が見てもすぐわかるようなコード）にやってみました。
> 回答8のお礼に書いたコードです。
＃８お礼欄のコードのようにある程度仕上がっているなら、それがいいと思います。
何が必要かを把握した上でなら、必要以上のことはしない方がいいですからね。

その上で＃８についてアドバイスを送るとすると、
> .NumberFormatLocal = "G/標準"
これは、誰が見ても判るようにコメントを残しておいた方がいいです。一見、唐突な処理ですから。
> .Value = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2)
これは、15年以上前の旧いExcel環境を想定しているのでもない限り、
Format()関数やFormat$()関数を使った方が比較的通りが良い、とは思いますけれども、、、。
「なんでわざわざ？」と思う方は多いと思いますが、通じる記述ではありますからお好みで。
> Me.Protect Password:=pw, UserInterfaceOnly:=True
> Me.Protect Password:=pw, UserInterfaceOnly:=False
UserInterfaceOnly:=Trueを設定したら、そのシートの親ブックが閉じるまでそのままにしておくのが通例です。
「他ユーザーがＶＢＡによってファイルを攻撃する」という想定でもない限り、ＶＢＡ開発者がハンドル出来るものですし、
そのシートの親ブックが閉じてしまえば、仮に作業中にブックを上書き保存したとしても、
次にそのブックを開いた時には必ずUserInterfaceOnly:=Falseから始まりますから、
> Me.Protect Password:=pw, UserInterfaceOnly:=False
という記述は、むしろ、省略してあげた方が無用な混乱を避けられる意味があります。

ところで、シートが保護してあるということがハッキリしてみると、表示形式を変更するのも少し違和感ありますね。
今後、もし設計変更の機会などあれば検討してみる価値はあると思うのですが、
＃１２-１３で示した方法の応用（というより原点回帰）として、
D2,F2,C4それぞれに対応した作業セル（非表示でも可）に予め数式を設定しておいて、
日付判定はそちらの値を元にする、というようなことが可能でしたらば、
もっとスッキリ書くことが出来ると思います。
今回のレスについては元々採否に頓着していませんでしたし、
私が示したかったのは寧ろここに書いたような設計見直しの可能性ことだったりもしますが、
条件が合う場面に出会うことでもあれば、思い出して貰えれば幸せです。

＃それではまた。ご自愛くださいませ。

お礼

アドバイスありがとうございます。

'8桁数値入力方式での日付エラー回避

と、コメントアウトしとます。

.Value = Format(.Value, "@@@@/@@/@@")
の方が一般的ということですね？

> 次にそのブックを開いた時には必ずUserInterfaceOnly:=Falseから始まりますから

これも存じませんでした。
てっきりそのままになってるのかと思ってました。

いろいろありがとうございました。

回答No.13

cj_mover

＃１２、ｃｊです。一部訂正、加筆です。

　　　　　　Case 1 To 2958465　'　「日付」または「Excel数式が日付と判断できる値」（1900/1/1-9999/12/31）
　　　　　　　　vBuf = Format$(vBuf, "yyyy/mm/dd")　'　〓　As String★　　時刻値が混じっている場合の為に日付で丸める

のところは、

　　　　　　Case 1 To 2958465　'　「日付」または「Excel数式が日付と判断できる値」（1900/1/1-9999/12/31）
　　　　　　　　If IsNumeric(c) Then
　　　　　　　　　　vBuf = CVErr(xlErrValue)　'　〓　As Error　　日付ではない数字の場合は、#VALUE! エラーを返す
　　　　　　　　Else
　　　　　　　　　　vBuf = Format$(vBuf, "yyyy/mm/dd")　'　〓　As String★　　時刻値が混じっている場合の為に日付で丸める
　　　　　　　　End If

でした。

テスト用サンプルの方にも、
＝＝＝＝＝＝＝＝＝
41832
＝＝＝＝＝＝＝＝＝
（他の日付と同値の整数値）を追加してあげてくださいませ。

失礼しました。

お礼

ありがとうございました。

回答No.12

cj_mover

こんにちは。お邪魔します。

色んなアプローチがあっていいと思いますけれど、自分は、
Excelに備わっている日付判定をそのまま活用することを最初から考えていました。
試しに書いてみたら、とても面白かったので、回答してみることにしました。
想定している"日付擬き値"が十分かどうか判りませんけど、結構マジで保守よりの回答（のつもり）です。

まずは、テスト用サンプル。
＝＝＝＝＝＝＝＝＝
20140712
2014/7/12
7月12日
2014年7月12日
H26.7.12
2014/7/12 22:06

0
-1
ABC
'20140712
'2014/7/12
'2014/07/12
'7/12
'7月12日
'14年7月12日
'2014年7月12日
'H26.7.12
'14-7-12
'2014-7-12
＝＝＝＝＝＝＝＝＝
※　先頭の６行は何れも日付値、
※　空行は空セルの意、
※　日付に変換しようがない数値と、文字列値、
※　' は文字列値を想定したプレフィックスなので、
　　コピペした後に、普通にトリミングしてから、F2、Enter、で確定し直します。
＃実体験として日付を文字列値で入力されている場面を何度も見かけたので、一応。
※　エラー値セルがあると（メッセージと共に）処理が失敗するように書いてます。

早速、実コード。
' ' ======================================================================
Private Sub Worksheet_Change(ByVal Target As Range)　'　8675020
Dim vBuf
Dim rMark As Range, rWork As Range, c As Range
Dim sRef As String
　　Set rMark = Intersect(Columns(3), Target)
　　If rMark Is Nothing Then Exit Sub
　　Application.EnableEvents = False
　　Set rWork = Cells(1, Columns.Count).End(xlToLeft)(1, 2)　'　作業セルを指定
On Error GoTo ErrOut_
　　rMark.NumberFormatLocal = "yyyy/m/d"　'　先に表示形式を決めておく
　　For Each c In rMark
　　　　If Not IsEmpty(c) Then
'Debug.Print c.Row,
　　　　　　sRef = c.Address(0, 0)
　　　　　　rWork.Formula = "=""""&iferror(--" & sRef & "," & sRef & ")"
　　　　　　vBuf = rWork.Value
　　　　　　Select Case vBuf
　　　　　　Case 1 To 2958465　'　「日付」または「Excel数式が日付と判断できる値」（1900/1/1-9999/12/31）
　　　　　　　　vBuf = Format$(vBuf, "yyyy/mm/dd")　'　〓　As String★　　時刻値が混じっている場合の為に日付で丸める
　　　　　　Case 19000101 To 99991231　 '　　「８桁表記の日付」。「Excelが日付として扱える整数値」に限る
　　　　　　　　vBuf = Format$(vBuf, "####/##/##")　'　〓　As String★　　整数を日付値に纏める
　　　　　　Case Else　'　以上の条件で日付ではないと判断された場合は、#VALUE! エラーを返す
　　　　　　　　vBuf = CVErr(xlErrValue)　'　〓　As Error
'　　　　　　　　Range(sRef & "," & c.EntireColumn.Address & "," & c.EntireRow.Address).Select
'　　　　　　　　MsgBox c.Formula & vbLf & "違っ！"
　　　　　　End Select
'Debug.Print RegDate, TypeName(RegDate)
　　　　　　c = vBuf
　　　　End If
　　Next
ErrOut_:
　　rWork.ClearContents　'　作業セルを値消去
　　Debug.Print Me.UsedRange.Column　'　作業セルによってUsedRangeが変更された場合、元に戻す為のダミー処理
　　Application.EnableEvents = True
If Err.Number Then MsgBox "失敗"
　　Set rMark = Nothing:　　Set rWork = Nothing
End Sub
' ' ======================================================================

（C列を対象に）For Each で書いたのは複数のサンプルで確認するのが容易だからです。
単セル仕様にするにはColumns(3)をRange("D2,F2,C4")とか書き換えるだけでも対応は可能です。

セルに返すVariant変数vBufの最終的なデータ型は、Variant/StringまたはVariant/Errorにしてあります。
日付型にしないと気持ち悪いという場合は（結果は変わりませんが）★印の行でCDate()関数などで処理することになります。
その場合は、c = vBuf、に代えて、c.Value = vBuf、とした方が記述としては一貫性がある（理解され易い）と思います。

ワークシート関数のIFERROR()関数を使っていますので、Excelバージョンのよっては書換えが必要です。

作業セルを使っているのは、Excelワークシートの機能としてのデータ型の変換機能を使う為です。
当初は数式だけでなんとか出来るかと思いEvaluateメソッドでトライしてみたのですが、
実際にセルで数式の戻り値を吐かないと型のキャストをして貰えないことに気づき、諦めようかと思いました。
しかし、試しに、作業セルで数式を計算させてみると、汎用的に型の変換をしてくれることに驚きました。
作業セルを使うなんてもっての他、という考えもあるでしょうし、勿論できれば使いたくないですけれど、
この方が簡単で確実なように思えて、敢えて採用してみました。
偶然の恩恵として、Select Case にて、入力できる日付期間を比較的簡単に制限できるようになっています。
ここまでの経緯だけでも私はやってて楽しかったのですが、もう一つ、
特に意図した訳ではないのですが、軽く書き上げようと進めていたら、
Variant型変数での型のキャスト、型の変化が目まぐるしくて、というか、Variant型って本当に凄いです。
と、こんなこと書くとプログラマー志向の高いVBA開発者には敬遠されるかも、ですが、
Excel VBAらしく一般機能の活用を図ると避けて通れないのがVariant型だったり型のキャストだったりもしますね。
＃ぃゃすみません勝手に一人で楽しんじゃって。質問あげてくれたことに感謝します。

> もう1点、日付をYYYYMMDDの連続数字で入力することは普通、エクセルではあまり見たことないですが、これって一般的な方法なのでしょうか？
Excelで一般的かというと、やや特殊に近いかも知れませんが、同じExcelでもデータベース扱う機会が多いと一般的でしょうね。
私自身も８桁数字で日付を扱うことの方がやや多いです。手書きの帳票でも中にはそういうフォーマットがあったりしますし、、、。
ですから、YYYYMMDDで入力してしまう人にとっては、それは癖だったりする場合もある訳で、決して変わったことをしている訳ではないですね。
ちなみに６桁や７桁という場合は、単なるタイプミスですから、ご安心を。

お邪魔しました。それではまた。

お礼

cj_moverさん、またお世話になります。
とても勉強になる回答をありがとうございます。
ただ今回は、コピペ入力や時間まで入るケースは想定しなくてよいので、もっと簡単（というか、後任者が見てもすぐわかるようなコード）にやってみました。
回答8のお礼に書いたコードです。
ありがとうございました。
これからもよろしくお願いいたします。

回答No.11

kkkkkm

たびたび横からで大変申し訳なく思います。すみません。

No8のコードですが
20141330と入力すると2015/1/30になります。
myMを1から12までに規制するコードを追加すれば解決しますが、どちらにしてもエラーメッセージを出して再入力を促すことになりますから、不正な日付の入力ミスはそのままセルに入力させておいてemaxemaxさんのエラー処理
If Not IsDate(.Value) Then MsgBox "日付を認識できません。"
を活かして、再入力を促す方が単純でいいのではないでしょうか。メッセージは不正な日付である旨を表示した方がいいと思いますが。

あら捜しをしているわけでありませんので、そのあたり誤解なきよう横からの意見ご容赦ください。

お礼

kkkkkm さん、ご検証ほんとにありがとうございます。
とてもありがたく勉強させていただきました。
今後もよろしくお願いいたします。
結局、回答8のお礼に書いたコードとなりました。
ありがとうございました。

回答No.10

tom04

何度もごめんなさい。
前回のコードで1行間違っていました。

＞myArry = Array(3, 5, 7, 8, 10, 12)
の行を
＞myArry = Array(1, 3, 5, 7, 8, 10, 12)
に変更してください。
（1月が抜けていました）

※　後からコードを見ると無意味なコードがいくつかありますが
大勢に影響はないと思います。m(_ _)m

お礼

ありがとうございます。

回答No.9

tom04

たびたびごめんなさい。

余計なお世話になるかもしれませんが、
No.8の中で
＞尚、2000年は100年に一度のうるう年でない年なのですが、この100年に一度は考慮していません。
の部分に間違いがありました。
正しくは2000年は「うるう年」です。

うるう年の説明として
【1】　西暦年号が4で割り切れる年をうるう年とする。
【2】【1】の例外として、西暦年号が100で割り切れて400で割り切れない年は平年とする。
というコトですので、
2100年・2200年。2300年は4で割り切れても「うるう年」ではないのですが
結局2000年・2400年はうるう年になります。

何度も失礼しました。m(_ _)m

お礼

ほんとにご丁寧にありがとうございます。
感謝いたします。

回答No.7

kkkkkm

横からすみません。

tom04さんの方法が基本的にいいと思うのですが、補足のコードで実行してみましたが、20140229だと2014/3/1になってしまいました。20120229はそのまま大丈夫でした。エクセル2013です。
単純に
.Value = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2)
でどうなのでしょう。これだと2014/02/29と表示されて補足で追加されているエラーチェックでメッセージが出ます。

お礼

あ、そうなんですね！
とても助かりました。

回答No.6

tom04

No.3です。

お礼欄のコードについてですが、
シリアル値と認識できる数値、もしくは必ず8桁数値で入力するのであれば
おそらく問題ないと思います。

前回「入力間違い」と書いたのは
8桁数値の　20140712　と入力しなければならない場合に
2014712　のような入力をすると（一桁月・一桁日付）とんでもない日付表示になってしまう可能性があるので
わざわざ念を押したまでです。
コード内の
＞If Not IsDate(.Value) Then MsgBox "日付を認識できません。"
という行を入れていても
Excelは　2014712　という数値をシリアル値として判断してしまうため
7416/2/3
というとんでもない表示になります。

この辺が心配だったので、あえて参考程度に年・月・日付　と入れる方法を提案したまでです。
※　Excelは連続数値をどこで区切って良いのか判断できないと思います。

結論として、数値を連続して入力する場合必ず「8桁」という前提であれば
お礼欄のコードで大丈夫だと思います。m(_ _)m

お礼

何度もありがとうございます。
助かりました。

回答No.5

NotFound404

#3 さんの
.NumberFormatLocal = "G/標準"
で初期化？案が良さげです。

#4 さん案だとまっさらな状態（標準書式）で、h26.7.12 とすると
S7.4.18 になってしまいます。
書式をあらかじめ、yyyy/m/d にしておけば大丈夫です。
Excel2010 で確認しましたです。
Kernel41病からメインPC 復活？ ＼(^o^)／
お邪魔様でした。。。

お礼

やはりそうですか、ありがとうございます。