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.4

nishi6

提示されているコードを３箇所修正すれば大丈夫と思います。Excel2010です。

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

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

金融系の某会社ですが、金融会社間のデータのやり取り、お客様とのデータのやり取り、メインフレームのデータ、メインフレームとのデータのやり取りは基本というか、昔から今も年月日は８桁が普通です。新人研修などではメインフレームのデータ８桁をExcel上の年月日に変換する方法（逆も）をいろいろ教えます。

ご参考に。

お礼

ありがとうございます。
やってみましたが、20140229等の誤入力だと、型が一致しないというエラーになってしまいます。

あと、8桁入力はデータ交換のためのやり方なんですね、勉強になりました。

回答No.3

tom04

こんにちは！

入力間違いがない！という前提であれば

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D2,F2,C4")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
.NumberFormatLocal = "G/標準"
If IsNumeric(.Value) And Len(.Value) = 8 Then
Application.EnableEvents = False
.Value = DateSerial(Left(.Value, 4), Mid(.Value, 5, 2), Right(.Value, 2))
Application.EnableEvents = True
End If
.NumberFormatLocal = "yyyy/m/d"
End With
End Sub

のような感じではどうでしょうか？
※　あくまでExcel的にシリアル値として認識できる入力方法、もしくは8桁数値の場合の時は大丈夫だと思いますが、
色々なケースの入力間違いを想定するとどんなコードを考えても限界があると思います。

別案として、年・月・日付　の数値を別々にインプットボックスに入力してもらう方法はどうでしょうか？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myY As Integer, myM As Integer, myD As Integer
If Intersect(Target, Range("D2,F2,C4")) Is Nothing Or Target.Count > 1 Then Exit Sub
On Error Resume Next
myY = Application.InputBox("年を (例) 2014 のように入力")
myM = Application.InputBox("月を入力")
myD = Application.InputBox("日付を入力")
With Target
.Value = DateSerial(myY, myM, myD)
.NumberFormatLocal = "yyyy/m/d"
End With
End Sub

こんな感じで・・・
ちゃんとシリアル値を入力できる人であれば面倒だと感じるかもしれませんね。m(_ _)m

お礼

ありがとうございます。
入力間違いを想定し、以下のようにしてみました。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D2,F2,C4")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
.NumberFormatLocal = "G/標準"
If .Value = "" Then Exit Sub
If IsNumeric(.Value) And Len(.Value) = 8 Then
Application.EnableEvents = False
.Value = DateSerial(Left(.Value, 4), Mid(.Value, 5, 2), Right(.Value, 2))
Application.EnableEvents = True
End If
.NumberFormatLocal = "yyyy/m/d"
If Not IsDate(.Value) Then MsgBox "日付を認識できません。"
End With
End Sub

あってますでしょうか？

補足

別案の、年・月・日付　の数値を別々にインプットボックスに入力する方法は帰って使う方の手間がかかるのでやはり無理ですね。

回答No.2

NotFound404

Formula で判断するとよいかも？
今Excel2002なので違う結果になるかも？

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo erH
　　Select Case Target.Address(0, 0)
　　　　Case "D2", "F2", "C4"
　　　　　　If Target.Formula = "" Or IsNumeric(Target.Formula) = False Then Exit Sub
　　　　　　If IsDate(Target.Formula) Then
　　　　　　　　Target.NumberFormatLocal = "yyyy/m/d"
　　　　　　Else
　　　　　　　　Application.EnableEvents = False
　　　　　　　　Target.Value = CDate(Format(Target.Formula, "@@@@/@@/@@"))
　　　　　　　　Application.EnableEvents = True
　　　　　　End If
　　　　Case Else
　　　　　　Exit Sub
　　End Select
　　Exit Sub
erH:
Application.EnableEvents = True
MsgBox Err.Number & vbCrLf & Err.Description
End Sub

ありえない日付（20001232　とか）でも不親切なメッセージになるので
Target.Value = CDate(Format(Target.Formula, "@@@@/@@/@@"))　を
if isdate(CDate(Format(Target.Formula, "@@@@/@@/@@")))
Target.Value = CDate(Format(Target.Formula, "@@@@/@@/@@"))
else
msgbox "Boo"
みたいなのが良いかも。

一般的かどうかは置いといて、そういう要望はあります。
時刻でも　12:15 のコロンが離れているので打ちづらいから
テンキーで12.15　と入力したら　12:15 になるようにして頂戴！とか。

お礼

ありがとうございます。
YYYYNNDD形式は正しく入力されました。
しかし、2014/7/12と、通常の日付をいれると、1932/4/18とかのとんでもない日付に化けました。年を入れず7/12とかの入力でも日付が変わってしまいます。

やりたいことは、たとえば
20140712
2014/7/12
2014/07/12
7/12
H26.7.12
以上、どれを入力されても正しく日付となることです。

回答No.1

noname#196873

わたしなら、ですが。
If Not IsDate(請求日) Then
' エラーメッセージ表示
MsgBox "yyyy/mm/ddの形式で入力してください。" _
& vbCrLf & "処理を中止します。", vbCritical
' マクロの実行を中止
Exit Sub
を途中に入れます。
ただ、IsDate関数は日本人にはなじみがない形式も日付と認めるのが難点ですが。
http://kozhouse.homeip.net/progtec/11/
http://it-doc.jp/index.php/excelforwork/vba/94-myisdate

お礼

早速ありがとうございます。
要は、IsDate関数でTRUE以外をすべて排除するということですか？
それが許されないので質問しているのです・・・。