エクセル ダブルクリックで処理日の入力

質問

お世話になります。

先般、お教え頂きました別のダブルクリックイベントプロシージャと
下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、ＶＢエディターにどのように記述したら良いかわかりません。

当方、かなりの初心者です。
よろしくご教授くださいませ。

【新しく加えたい処理】

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b4:C999")) Is Nothing Then Exit Sub
If ActiveCell = "" Then
ActiveCell = Date
Cancel = True
End If
End Sub

【もともと使っている処理】

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h1:h999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "有"
ElseIf .Value = "有" Then
.Value = "無"
ElseIf .Value = "無" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "要"
ElseIf .Value = "要" Then
.Value = "不要"
ElseIf .Value = "不要" Then
.Value = ""
End If
End With
End If
End Sub

よろしくお願いします。

回答No.1

n-jun · ベストアンサー

エクセル　マクロ　ダブルクリックで…(2)
http://okwave.jp/qa4807008.html
Ｎｏ３さんの回答を参考にされれば、自ずと答えが見えるのではないでしょうか？

お礼

遅くなりまして大変申し訳ございませんでした。

ご丁寧に教えくださりましてありがとうございました。

まだどうして処理が実行されない場合があるのか、よくわかっていないのですが、複数の処理を同時に組み合わせてその問題が起こることがあるようです。

またよろしくお願いいたします。

補足

はい、それが、質問しながら自分でもやってみていたのですが…
やっぱりおかしいのでしょうね。セルを選択されるだけで、どれも実行されてくれません。

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h2:h999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "有"
ElseIf .Value = "有" Then
.Value = "無"
ElseIf .Value = "無" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("i2:i999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "要"
ElseIf .Value = "要" Then
.Value = "不要"
ElseIf .Value = "不要" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("b2:C999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = Date
Cancel = True
End If
End With
End Sub

二度も三度も同じようなことを、ほんとに恐縮です。。。

回答No.4

hige_082

前回、回答したものですが
＃２さんのがダメで、＃３さんがＯＫのようですが
基本的に両方の処理は同じです
違いは、処理の実行範囲だけですよ

これでは如何

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h1:h999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "有"
ElseIf .Value = "有" Then
.Value = "無"
ElseIf .Value = "無" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("i1:i999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "要"
ElseIf .Value = "要" Then
.Value = "不要"
ElseIf .Value = "不要" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("b4:C999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = Date
Cancel = True
End If
End With
End If
End Sub

これで＃３さんと同じ範囲を処理します
＞修正してみたのですが、なぜでしょうか。できないのです。
出来ないではなく、どう、うまく行かないのか書いた方が、解決が早いよ
今回の場合、処理的にはエラーは無いと思うので
ただ、B2:C3に日付を入力したくないのに、入力されてしまうと言うことですよね

補足

大変遅くなりもうしわけございません。

「できない」の内容ですが、なぜかダブルクリックをするとマクロの実行でなく、セルが選択されるだけなのでした。

ある実行を解除（ＶＢＡを削除）してエクセル再起動したら、別の処理は実行されましたが、、、。

コピペしているだけなので、それぞれの記述は間違っていないと思います。

ひとまず、お教え頂きました内容で処理は行われました。
ありがとうございます。

回答No.3

merlionXX

もう回答は出ていますが、以前回答した方法（Select Case）での一例です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Row > 999 Then Exit Sub '1000行以下の場合終了
Select Case .Column '列でケース分け
Case 9 'I列の場合
Select Case .Value '値でケース分け
Case "": .Value = "要"
Case "要": .Value = "不要"
Case "不要": .Value = "請求"
Case "請求": .Value = ""
End Select
Cancel = True
Case 8 'H列の場合
Select Case .Value '値でケース分け
Case "": .Value = "有"
Case "有": .Value = "無"
Case "無": .Value = ""
End Select
Cancel = True
Case 2, 3 'B,C列の場合
If .Row < 4 Then Exit Sub '1～3行目の場合終了
.Value = IIf(.Value = "", Date, .Value) '空白なら日付
Cancel = True
End Select
End With
End Sub

お礼

できました！各項目の右に『'説明 』　を添付してくださったので、とても良くわかりました。自分の初めにトライしたやり方に固執してたのだと思います。
難しいですが、教えて頂いて実行できた時は本当に嬉しいですね。

また情けない質問をさせて頂くかも知れませんがよろしくお願い致します。

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

補足

ありがとうございます。早速トライさせて頂きます。
前回お教え頂いた事を理解しきれておらず、大変申し訳ございません。

回答No.2

n-jun

＃１です。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h2:h999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "有"
ElseIf .Value = "有" Then
.Value = "無"
ElseIf .Value = "無" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("i2:i999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "要"
ElseIf .Value = "要" Then
.Value = "不要"
ElseIf .Value = "不要" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("b2:C999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = Date
Cancel = True
End If
End With
End If '　←追加
End Sub

で、動いているようです。

補足

それが…
修正してみたのですが、なぜでしょうか。できないのです。

添削ばかり依頼するような形となってしまい大変申し訳ございません。
ファイルを使用する人がＰＣに柔軟な方ばかりでないため、なんとか、未知の領域のＶＢＡに生意気に踏み込んでみたものの。。。

引き続き勉強は続けます。。。

（念のため、添付してみます。）

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("h2:h999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "有"
ElseIf .Value = "有" Then
.Value = "無"
ElseIf .Value = "無" Then
.Value = ""
End If
End With
ElseIf Not Intersect(Target, Range("i2:i999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = "要"
ElseIf .Value = "要" Then
.Value = "不要"
ElseIf .Value = "不要" Then
.Value = ""
End If
End With

ElseIf Not Intersect(Target, Range("b2:C999")) Is Nothing Then
With Target
If .Value = "" Then
.Value = Date
Cancel = True
End If
End With
End If
End Sub

やはり間違っておりますでしょうか。。。