EXEL VBA で入力規則を変更するには

質問

現在去年のデータの入力作業をしていますが年月日を入力する際、
"2010/4/1"とか"2010/4/28"と打たなければならず、セルの書式設定とか
入力規則でもできません。
Ａ３のセルにきたら"2010/"が既にはいっており、続けて"4/1"とか"4/28"とか日付だけを入力すればよいようにVBAでやれば出来ると思い、ここ２日ほどサイトとか見て勉強しましたが下記のところまが精一杯で動きません。

Private Sub Workbook_Activate()
With Selection.Validation
.Delete
Range("A3", "A300").Select
Add Type:=xlValidateDate
Formula1 = "2010/mm/dd"
End With
End Sub

どなたかご教授お願いします。

回答No.9

mitarashi · ベストアンサー

#6です。
#7の補足は両方とも、
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

#8の補足は、
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
と
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
前者は選択セル変化、後者はセルの値変化ですので、異なるイベントプロシージャです。ご確認下さい。

お礼

あーなるほど、そういう事ですね、わかりました。
本当にありがとうございました。

回答No.8

mitarashi

#6です

「途中でやめたくなった時」というのは、#6の例で言うとA3:A300の範囲で入力していて、最後まで入力せずに別の場所に移動したとき、記入しかけの"2010/"が残ってしまうため、その対策という意味です。そういう趣旨でも動いていないでしょうか？
補足のコードをみると、入力後のセル移動方向を「右」に設定されている様な気もしますので、その場合は対策不要です。

#7の補足に対してですが、同じイベントプロシージャを2個置く事はできませんので、一つにまとめて、中で条件分岐する必要があります。
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Sh.Range("C7:E299")) Is Nothing Then
SendKeys "%{DOWN}"
Else
If Not Intersect(Target, Sh.Range("B7:B299")) Is Nothing Then
If Target.Value = "" Then
Target.Value = "2010/"
Application.SendKeys "{f2}"
End If
End If
End If
Application.EnableEvents = True
End Sub
なお、Alt+↓を積極的に使う方法は勉強になりました。

補足

解答ありがとうございます。

なるほど、Elseで分岐させればよいのですね、
でも下記はNO.5さんの解答なのですが、同じイベントプロシージャを2個置いてこれで動くのですが？

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C7:E299")) Is Nothing Then
SendKeys "%{DOWN}"
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column = 2 And IsDate(.Value) Then
.Value = DateSerial(Year(.Value) - 1, Month(.Value), Day(.Value))
.NumberFormatLocal = "yyyy/m/d;@"
End If
End With
Application.EnableEvents = True
End Sub

すみません、宜しくご回答お願いします。

回答No.7

mitarashi

#6です。
Intersect(Target, Target.Parent.Range("A3:A300"))
なんて事をしないで、
Intersect(Target, Sh.Range("A3:A300"))
でOKでした。意味は一緒ですが．．．
ThisWorkbookモジュールをあまり使わないことが露呈してしまいました。

お礼

それから、現在下記１．を入れていてその下に教えていただいた２．を入れるとコンパイルエラー、名前が適切ではないと出ます。
１．だけとか２．だけなら動きます。
PrivateSub　
End　Subでひとつにしても駄目なのですが、何か制約があるのですね。
済みません、お手数ですが宜しくお願いします。

１．Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("C7:E299")) Is Nothing Then
SendKeys "%{DOWN}"
End If
End Sub

２．Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("B7:B299")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value = "" Then
Target.Value = "2010/"
Application.SendKeys "{f2}"
End If
Application.EnableEvents = True
End Sub

補足

下の［If Target.Value = "2010/" Then”］
を上の［If Target.Value = "" Then　Target.Value = "2010/"］
にしてやると動きますが？
と書きましたがやはり動きませんね？

'下記は途中でやめたくなったとき、"2010/"というゴミが残らない様にするため
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("A3:A300")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value = "2010/" Then
Target.ClearContents
End If
Application.EnableEvents = True
End Sub

回答No.6

mitarashi

こんなので如何でしょうか。ThisWorkbookモジュールに記述します。ご参考まで。

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("A3:A300")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value = "" Then
Target.Value = "2010/"
Application.SendKeys "{f2}"
End If
Application.EnableEvents = True
End Sub

'下記は途中でやめたくなったとき、"2010/"というゴミが残らない様にするため
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Target.Parent.Range("A3:A300")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value = "2010/" Then
Target.ClearContents
End If
Application.EnableEvents = True
End Sub

補足

大変ありがとうございます。
皆さんこんなのをすらすらと思いつくのですから、ホントに凄いですね。

それで上は動きますね、下は動かない様なのですが？

下の［If Target.Value = "2010/" Then”］
を上の［If Target.Value = "" Then　Target.Value = "2010/"］
にしてやると動きますが？

それから途中でやめたくなった時と言うのはどういう意味なのでしょう？
ゴミが残らない様にするためと？

宜しくお願いします。

回答No.5

noname#187541

No.3です。

私が提示したマクロでは、すべてのセルで日付を入力すれば２０１０年になるようにしています。
Ａ列のみで行いたいということであれば

If IsDate(.Value) Then　を　If .Column = 1 And IsDate(.Value) Then　としてください。

要するに、ここの部分で入力した内容やセル番地（今回は列のみ）を判断しています。

お礼

お世話になりました。
M-SOFTさんの解答もすばらしかったのですが、もう一人の方のは
セル上で2010/と勝手に出てくれたのですみませんが、あちらに２０P差し上げました。
ありがとうございました。

補足

解答大変ありがとうございます。
出来ました。
意味はわかりませんが、これを基に勉強したいと思います。
ほんとうにありがとうございました。

回答No.4

某HN クロメート(Chromate)（@CoalTar）

>Ａ３のセルにきたら"2010/"が既にはいっており、
>続けて"4/1"とか"4/28"とか日付だけを入力すればよいように

A3セルまたはセル範囲に 2010/ で[Ctrl]+[Enter]
入力するときは [F2]キーを押してから入力する

>２年分、２４シート、１シート３００行くらいありますので、
もう入力済みなの？
質問と異なる。。。

同形のシートだとして対象シートをすべて選び、
対象の列(行)を選択する。
[Ctrl]+[H]置換 2011/ → 2010/ [すべて置換]

補足

解答ありがとうございます
ちょっと、意味が？？？
まだ２ヶ月分しか入力はしていません。
それとやはり2010/8/9の日付として入れて、このデータも使用したいので
ちょっと、意図とは違うようです。
せっかく解答いただいてすみません。

回答No.3

noname#187541

こんにちは。

VBAを使っても「入力規則」では無理。
「2010年で入力する」ではなくて「入力した日付を2010年にする」とします。

具体的には、シートのChangeイベントを使います。すべてのシートであれば、ThisWorkbookのSheetChangeイベントを使います。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　Application.EnableEvents = False
　With Target
　　If IsDate(.Value) Then
　　　　　.Value = DateSerial(Year(.Value) - 1, Month(.Value), Day(.Value))
　　　　　.NumberFormatLocal = "yyyy/m/d;@"
　　End If
　End With
　Application.EnableEvents = True
End Sub

どうでしょうか。

お礼

大変大変、ありがとうございます。
そうですね、出来てますね。さすがですね、しかしどのセルも全部2010/**/**となってしまいます。
例えばA列を指定するには”Range("A2,A300").Selectこれでいいのでしょうか？”を入れたらよいんですよね？

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
With Target
If IsDate(.Value) Then
.Range("A2,A300").Select
.Value = DateSerial(Year(.Value) - 1, Month(.Value), Day(.Value))
.NumberFormatLocal = "yyyy/m/d;@"
End If
End With
Application.EnableEvents = True
End Sub

と色々入れてみますが、出来ません。
よろしくお願いします

回答No.2

MackyNo1

去年のデータを入力するためだけに、わざわざＶＢＡを設定することもないと思います。

このようなケースで最も簡便な操作方法は、すべてのセルに「4/1」のように入力してひとまず今年の日付として入力し、最後に、空白セルに「365」と入力して右クリック「コピー」、昨年の日付にしたいセルを（Cｔｒｌキーを押しながらすべて）選択し、右クリック「形式を選択して貼り付け」で「減算」してください。

補足

VBAにすると何行にもなり、かなりややこしいでしょうか？
７行か８行のモジュールで出来るならThisWorkbookで指定してやれば良いかと。
２年分、２４シート、１シート３００行くらいありますので、簡単に出来るのでしたら
VBAの方が良いかと思いまして。
リストボックスでマウスで▼をクリックしなくても表示されるのを教えて頂きましたが
凄く便利で、重宝してますし、２４シートコピーして減産してって作業はチョット・・・。

せっかく解答していただいたのにすみません。
宜しくお願いします。

回答No.1

mks1902

ＢＶＡじゃないですが
ＤＡＴＥ関数で出来ます

セルＢ３に年号
セルＣ３に月
セルＤ３に日

=DATE(B3,C3,D3)

お礼

解答ありがとうございます。
セルが３つに分割されるのはチョット、具合悪いです。