• ベストアンサー
  • 困ってます

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の連続数字で入力することは普通、エクセルではあまり見たことないですが、これって一般的な方法なのでしょうか?

共感・応援の気持ちを伝えよう!

  • 回答数15
  • 閲覧数2680
  • ありがとう数15

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.8
  • tom04
  • ベストアンサー率49% (2537/5117)

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

質問者からの補足

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

関連するQ&A

  • excel2007 VBで

    下記のマクロ作成して実際にセルにA、あるいは何かデータを入力しても下記イベント?が発生している気配がありません。 Application.EnableEvents = Falseの行がなにか問題なのでしょうか。実プログラムは If Target.Value = "A" Or Target.Value = "A" Thenの他にB、C、計算も含んでいるのですがApplication.EnableEvents = TrueはEnd Subの前行に入れてあります。 他に設定することがあるのでしょうか。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range)    If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 Application.EnableEvents = False '割込み停止 ’[B3] = 123 ’Stop If Target.Value = "A" Or Target.Value = "A" Then Target.Value = "A" End If Application.EnableEvents = True '割込み再開 End Sub excel2007 VB6.5です。

  • VBAの日付チェックでオーバーフローを回避したい。

    VBAの日付チェックでオーバーフローを回避したい。 ExcelのG列のセルに入力されたものが日付型であるかどうかのチェックかけたいと思います。 以下のコードだと、数字2958466以上の入力でオーバーフローが発生します。 これを回避する方法はありますか? セルを日付型に設定しているため、2958465(2999/12/31)までしか判別できないのでしょうが、 利用者が2958466以上を入力してしまう可能性はあります。 オーバーフローではなく、エラーメッセージが出せたら・・・と思います。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If Application.EnableEvents = True End If End Sub こんなコードも試しましたが、結果は同じでした。 ↓ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target > 2958466 Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select Else If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If End If Application.EnableEvents = True End If End Sub On Error Resume Next や On Error GoTo ... での対処も考えましたが、同じ結果でした。 何か良い方法がありましたら、お願いいたします。

  • エクセルで数字を入力すると隣のセルに特定の文字に変換する方法

    Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case 93 Target.Value = "アフガニスタン" Case 971 Target.Value = "アラブ首長国連邦" Case 967 Target.Value = "イエメン共和国" End Select Application.EnableEvents = True End Sub 国別電話番号の表を作りたいのですが、VLOOKUP関数を使用せずに上記のプログラムを利用して数字を入れたセルの隣のセルに特定の文字を反映させたいのですが、初心者の為に苦労しております。 どのようなプログラムを付け加えたら良いのかお教えください。 よろしくお願いいたします。

その他の回答 (14)

  • 回答No.15

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

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.14

#12-13、cjです。#12お礼欄へのレスです。 > ただ今回は、コピペ入力や時間まで入るケースは想定しなくてよいので、もっと簡単(というか、後任者が見てもすぐわかるようなコード)にやってみました。 > 回答8のお礼に書いたコードです。 #8お礼欄のコードのようにある程度仕上がっているなら、それがいいと思います。 何が必要かを把握した上でなら、必要以上のことはしない方がいいですからね。 その上で#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を設定したら、そのシートの親ブックが閉じるまでそのままにしておくのが通例です。 「他ユーザーがVBAによってファイルを攻撃する」という想定でもない限り、VBA開発者がハンドル出来るものですし、 そのシートの親ブックが閉じてしまえば、仮に作業中にブックを上書き保存したとしても、 次にそのブックを開いた時には必ずUserInterfaceOnly:=Falseから始まりますから、 > Me.Protect Password:=pw, UserInterfaceOnly:=False という記述は、むしろ、省略してあげた方が無用な混乱を避けられる意味があります。 ところで、シートが保護してあるということがハッキリしてみると、表示形式を変更するのも少し違和感ありますね。 今後、もし設計変更の機会などあれば検討してみる価値はあると思うのですが、 #12-13で示した方法の応用(というより原点回帰)として、 D2,F2,C4それぞれに対応した作業セル(非表示でも可)に予め数式を設定しておいて、 日付判定はそちらの値を元にする、というようなことが可能でしたらば、 もっとスッキリ書くことが出来ると思います。 今回のレスについては元々採否に頓着していませんでしたし、 私が示したかったのは寧ろここに書いたような設計見直しの可能性ことだったりもしますが、 条件が合う場面に出会うことでもあれば、思い出して貰えれば幸せです。 #それではまた。ご自愛くださいませ。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

アドバイスありがとうございます。 '8桁数値入力方式での日付エラー回避 と、コメントアウトしとます。 .Value = Format(.Value, "@@@@/@@/@@") の方が一般的ということですね? > 次にそのブックを開いた時には必ずUserInterfaceOnly:=Falseから始まりますから これも存じませんでした。 てっきりそのままになってるのかと思ってました。 いろいろありがとうございました。

  • 回答No.13

#12、cjです。一部訂正、加筆です。       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

こんにちは。お邪魔します。 色んなアプローチがあっていいと思いますけれど、自分は、 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 ========= ※ 先頭の6行は何れも日付値、 ※ 空行は空セルの意、 ※ 日付に変換しようがない数値と、文字列値、 ※ ' は文字列値を想定したプレフィックスなので、   コピペした後に、普通にトリミングしてから、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  '  「8桁表記の日付」。「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でもデータベース扱う機会が多いと一般的でしょうね。 私自身も8桁数字で日付を扱うことの方がやや多いです。手書きの帳票でも中にはそういうフォーマットがあったりしますし、、、。 ですから、YYYYMMDDで入力してしまう人にとっては、それは癖だったりする場合もある訳で、決して変わったことをしている訳ではないですね。 ちなみに6桁や7桁という場合は、単なるタイプミスですから、ご安心を。 お邪魔しました。それではまた。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.11
  • kkkkkm
  • ベストアンサー率58% (853/1461)

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

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.10
  • tom04
  • ベストアンサー率49% (2537/5117)

何度もごめんなさい。 前回のコードで1行間違っていました。 >myArry = Array(3, 5, 7, 8, 10, 12) の行を >myArry = Array(1, 3, 5, 7, 8, 10, 12) に変更してください。 (1月が抜けていました) ※ 後からコードを見ると無意味なコードがいくつかありますが 大勢に影響はないと思います。m(_ _)m

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。

  • 回答No.9
  • tom04
  • ベストアンサー率49% (2537/5117)

たびたびごめんなさい。 余計なお世話になるかもしれませんが、 No.8の中で >尚、2000年は100年に一度のうるう年でない年なのですが、この100年に一度は考慮していません。 の部分に間違いがありました。 正しくは2000年は「うるう年」です。 うるう年の説明として 【1】 西暦年号が4で割り切れる年をうるう年とする。 【2】【1】の例外として、西暦年号が100で割り切れて400で割り切れない年は平年とする。 というコトですので、 2100年・2200年。2300年は4で割り切れても「うるう年」ではないのですが 結局2000年・2400年はうるう年になります。 何度も失礼しました。m(_ _)m

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.7
  • kkkkkm
  • ベストアンサー率58% (853/1461)

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

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.6
  • tom04
  • ベストアンサー率49% (2537/5117)

No.3です。 お礼欄のコードについてですが、 シリアル値と認識できる数値、もしくは必ず8桁数値で入力するのであれば おそらく問題ないと思います。 前回「入力間違い」と書いたのは 8桁数値の 20140712 と入力しなければならない場合に 2014712 のような入力をすると(一桁月・一桁日付)とんでもない日付表示になってしまう可能性があるので わざわざ念を押したまでです。 コード内の >If Not IsDate(.Value) Then MsgBox "日付を認識できません。" という行を入れていても Excelは 2014712 という数値をシリアル値として判断してしまうため 7416/2/3 というとんでもない表示になります。 この辺が心配だったので、あえて参考程度に年・月・日付 と入れる方法を提案したまでです。 ※ Excelは連続数値をどこで区切って良いのか判断できないと思います。 結論として、数値を連続して入力する場合必ず「8桁」という前提であれば お礼欄のコードで大丈夫だと思います。m(_ _)m

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

  • 回答No.5

#3 さんの .NumberFormatLocal = "G/標準" で初期化?案が良さげです。 #4 さん案だとまっさらな状態(標準書式)で、h26.7.12 とすると S7.4.18 になってしまいます。 書式をあらかじめ、yyyy/m/d にしておけば大丈夫です。 Excel2010 で確認しましたです。 Kernel41病からメインPC 復活? \(^o^)/ お邪魔様でした。。。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

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

関連するQ&A

  • Excel 置換? VBA

    先ほども質問したんですが、 A1に010と入力すると田中、020入力で鈴木と出来るように、 ------------------------------------------------------ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub Select Case Target.Value Case "010": myStr = "田中" Case "020": myStr = "鈴木" Case "030": myStr = "岡田" Case "": myStr = "" Case Else: myStr = "非該当" End Select Application.EnableEvents = False On Error GoTo line Target.Value = myStr line: Application.EnableEvents = True End Sub ---------------------------------------------------- を教えていただきました! が、A2でも同じようなことを行いたいのです! VBAの知識が乏しいのでコピペでいろいろやってみたのですが、エラーで出来ませんでした…。 A1 A2 ・ ・ ・ と同じように入力できるようにするにはどのようにすればよいのでしょうか?もう一度教えて下さい。よろしくお願いします。

  • VBA(エクセル)での条件付日付表示について

    A列に数字を入力、A25でA列の合計をするべく「=SUM(A1:A24)」という計算式の入ったシートがあるとします。(以下、B、C…と同じような列が続く) A列に入力されている数字が変更され、A25の合計値が変わった場合、その下のセル(A26)に日付と時刻を表示させたいのですが、うまくいきません。 ネットで検索したら、特定のセルの値が変更された時に日付と時刻を表示させる方法は何となくわかったのですが、この場合だと、直接A25のデータ変更された時のみA26に日付が表示されるだけで、A25の合計値がいくら変わったところで最新の時刻を表示させる事が出来ません。 どうすれば、A26に時刻を表示出来るのでしょうか? EXCEL、VBA初心者共に初心者で、あまりよくわかっていなくて申し訳ないのですが、どうぞご教授よろしくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng As Range Dim i As Range Set myRng = Me.Application.Intersect(Target, Me.Range("25:25")) If Not myRng Is Nothing Then Application.EnableEvents = False For Each i In myRng If IsEmpty(i.Value) Then i.Offset(1, 0).ClearContents Else i.Offset(1, 0).Value = Now End If Next i Application.EnableEvents = True End If End Sub

  • マクロに詳しい方!エクセルの日付入力について

    エクセルの日付入力について、例えばB列に何か入力したら自動的にA列に入力した日がB列に表示されるようにする方法(TODAY関数のように常に現在の日付ではなく、入力した日のまま固定にする方法)について検索したところ、下記の通り、マクロをつかった回答がありました。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1413916824 B列に入力し、A列に日付を書き込む場合 B1→A1 B2→A2 B3→A3 … -------------------- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Application.EnableEvents = False Target.Offset(, -1).Value = Now Application.EnableEvents = True End Sub -------------------- 小生はマクロが分かりませんが、上記のコードをコピペ入力すると、その通りになりました。 そこで、みなさんにご相談ですが、これをA列に入力→B列に日付、C列に入力→D列に日付、E列に入力→F列に日付・・・・・というようにしたいのですが、そのコードを教えて頂けないでしょうか。 何卒お知恵をお借りしたくお願い致します。

  • VBA初心者です

    VBA初心者です。 同じセルに数字を入れて足し算して行きたいんですが! 下記のVBA見つけたのですが、A1に数字を入れて答えがE1に出るんですが、同じ事を A2、A3、A4、A5答えもE2、E3......で増やしたいのですが、どうするか分かりません。 どなたか教えてください。 宜しくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim inp, outp As String inp = "$A$1" outp = "E1" Application.EnableEvents = False If Target.Address = inp Then Range(outp).Value = Range(outp).Value + Target.Value If Target.Value <> "" Then ActiveCell.Offset(-1, 0).Select Else Range(outp).Value = 0 End If End If Application.EnableEvents = True End Sub

  • EXCEL VBAについて教えてください

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これをたとえば同一シートのA1~E10のセルとA12~E22にも同じよう別々に処理できるように設定したいのですが、どのようにすればいいのでしょうか?ちなみにA11~E11とA23~E23は合計を表示するセルにしたいです。 Excelのバージョンは2003です。 よろしくお願い致します

  • 連続データのVBAの質問

    お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC1に年月を表記させ、そのC1セルの年月を変更した場合B9&#65374;B39のセルが自動で連続データの数字を記入し、B9&#65374;B39のどこかのセルを空白にすると、そのセル以降も空白になります。 そしてR8&#65374;R38は、指定範囲のセルに数字を入力したら、そのセル以降の指定した範囲のセルに同じ数字を自動入力するVBAです。 そこで質問ですが、質問した現在は2013年12月ですが、日本時間の現在の年月以前の年月(今で言うと2013年11月以前)をC1に記入した場合はB9&#65374;B39の連続データの数字が切り替わらない様にするには、どうすれば宜しいでしょうか?

  • VBAの時間入力について

    先日、時間を文字列で、HH:mmのフォーマット入力するPGを教えて頂き、 内容理解をしているのですがわからない部分があります。 ★の部分の条件で、00:00も入力したいです。 ご存知か方がおられましたら教えてください。 よろしくお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) 'この行から 'Intersect:http://officetanaka.net/excel/vba/tips/tips118.htm 'Is Nothing:nullではない 'Selection.Count <> 1:選択数が1以下ではない(<> :等しくない) ' Not IsNumeric(Target):数値ではない If Intersect(Target, Columns(12)) Is Nothing Or Selection.Count <> 1 _ Or Not IsNumeric(Target) Then Exit Sub ' 'Target:セルの値は24:00以下 '2つの数値の除算を行いし,その剰余を返す 'Mod:2つの数値の除算を行いし,その剰余を返す '★ここで00:00時も入力したい。 If Target <= 2400 And Target Mod 100 < 60 Then ' Application.EnableEvents = False ' With Target ' If Len(Target) = 3 Then .Value = 0 & ":" & Right(Target, 2) ElseIf Len(Target) = 3 Then .Value = Left(Target, 1) & ":" & Right(Target, 2) Else .Value = Left(Target, 2) & ":" & Right(Target, 2) End If .NumberFormatLocal = "hh:mm" ' End With ' Application.EnableEvents = True ' Else MsgBox "入力値が不正です。" ' With Target ' .Value = "" .Select End With Exit Sub ' End If End Sub 'この行まで

  • エクセル2013VBA Changeイベント 選択

    お世話になります。一度質問を締め切ったのですが、色々やっているうちに問題がでてきたので再投稿いたしました。Excel2013です。 計画のファイルがあります。 例えば、"テーブル"シートのA列に品物A、品物B、品物C・・・、と入力されていて、B列にはA列の品物に対応して、付属A、付属B、付属Aなどと入力されているとします。実際は、品物数は数千種類あります。(この例の場合は、品物Aと品物Cは同じ付属を使う) "計画"シートには、A列にデータの入力規則のリストより、A社やB社・・・を選択し、 さらにB列は入力規則のリストより、=INDIRECT(B2)などといれて、A列の入力規則に対して品物Aや品物B・・・などを選択します。選択するようにしています。 それで、品物Aを選んだら、その下の行に付属Aとか自動ででるようにしたいと思っています。 (列は増やしたくありません) 入力範囲のどこでも選択をできるようにしておきたいので、入力範囲にはすべてリストが設定されており、数式を入れることはできません。 とりあえず、品物を入力する範囲は、C2:C25,G2:G25範囲です。 その状態で、 とりあえずご教授いただいて下記コードまでたどりついていき通常は大丈夫なのですが、B列とC列をまとめて選択コピーして貼り付けると、付属Aと出るべきところが何も起こりません。アクティブセルが隣の列を選択しているためだと思われますが、どうすればよいか分かりません。 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = True On Error GoTo mExit Application.EnableEvents = False If Intersect(Target, Range("C2:C25,G2:G25")) Is Nothing Then Application.EnableEvents = True Exit Sub Else If Target.Offset(1, 0).Value = "" Then Target.Offset(1, 0).Value = Application.WorksheetFunction.VLookup(Target.Value, Sheets("テーブル").Range("B:C"), 2, False) Application.EnableEvents = True End If End If Application.EnableEvents = True Exit Sub mExit: Application.EnableEvents = True End Sub 度々お手数をおかけいたしますが、ご教授ください。

  • 連続データのVBAの質問

    お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Range("C1") <= Date - Day(Date) Then Exit Sub If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC1に年月を表記させ、そのC1セルの年月を変更した場合B9&#65374;B39のセルが自動で連続データの数字を記入し、B9&#65374;B39のどこかのセルを空白にすると、そのセル以降も空白になります。 そこで質問ですが、例えばB14の数字を消すとB15&#65374;39まで空白のセルになります。そして、B20に1と入力するとB21&#65374;39に連続データの数字が自動記入されます。 そしてC1の年月を次の月に更新した際は、B39で示された数字以降の連続データをB9に表示させるには、どうすれば良いでしょうか?

  • VBA Changeイベントのエラー

    エクセルで簡単な計算書を作成しています。(マクロ初心者) ちなみにこのコードは自分で作成したものではなく、人から聞いていじってみました。 Private Sub Worksheet_Change(ByVal Target As Range) '一度に複数セルの値が変更された場合は終了 '(A5:C5を選択しDeleteも含みます。) If Target.Count > 1 Then Exit Sub If Intersect(Target, Me.Range("H170:K170", "H171:K171","C76")) Is Nothing Then Exit Sub Application.EnableEvents = False '数値かつ空白以外の場合 If IsNumeric(Target.Value) And Target.Value <> "" Then Me.Range("M170").Formula = "=if(iserror(H170*I170*J170*K170),""-"",H170*I170*J170*K170)" '空白の場合 ElseIf Target.Value = "" Then Me.Range("H170:K170,M170").Value = "-" End If Application.EnableEvents = True Application.EnableEvents = False '数値かつ空白以外の場合 If IsNumeric(Target.Value) And Target.Value <> "" Then Me.Range("M171").Formula = "=if(iserror(H171*I171*J171*K171),""-"",H171*I171*J171*K171)" '空白の場合 ElseIf Target.Value = "" Then Me.Range("H171:K171,M171").Value = "-" End If Application.EnableEvents = True Application.EnableEvents = False '空白の場合 If Target.Value = "" Then Me.Range("D76:K76","C76").Value = "-" End If Application.EnableEvents = True End Sub H170、I170、J170、K170のどれかに数値の入力があった場合、M170に計算式を入力。 H170、I170、J170、K170のどれかの値をDELETEキーでクリアした場合、H170、I170、J170、K170、M170に"-"を入力。 その他に似たような処理がたくさん出てくるので、H171の処理とC76をDELETEキーでクリアした場合の処理を自分で考えて作ってみたのですが、うまく実行されません。H171~の処理はうまくいったので単純にコードをどんどん追加していけば動くと思ったんですが、いろいろ調べてもどうも方法がわからず進みません・・・ 解決してもらえるでしょうか・・