- ベストアンサー
エクセル ダブルクリックで処理日の入力
お世話になります。 先般、お教え頂きました別のダブルクリックイベントプロシージャと 下記の当日の日付を入力するという処理を同じシート上で行いたいのですが、ＶＢエディターにどのように記述したら良いかわかりません。 当方、かなりの初心者です。 よろしくご教授くださいませ。 【新しく加えたい処理】 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 よろしくお願いします。
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (3)
- hige_082
- ベストアンサー率50% (379/747)
前回、回答したものですが ＃２さんのがダメで、＃３さんがＯＫのようですが 基本的に両方の処理は同じです 違いは、処理の実行範囲だけですよ これでは如何 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に日付を入力したくないのに、入力されてしまうと言うことですよね
補足
大変遅くなりもうしわけございません。 「できない」の内容ですが、なぜかダブルクリックをするとマクロの実行でなく、セルが選択されるだけなのでした。 ある実行を解除（ＶＢＡを削除）してエクセル再起動したら、別の処理は実行されましたが、、、。 コピペしているだけなので、それぞれの記述は間違っていないと思います。 ひとまず、お教え頂きました内容で処理は行われました。 ありがとうございます。
- merlionXX
- ベストアンサー率48% (1930/4007)
もう回答は出ていますが、以前回答した方法（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
お礼
できました！各項目の右に『'説明 』 を添付してくださったので、とても良くわかりました。自分の初めにトライしたやり方に固執してたのだと思います。 難しいですが、教えて頂いて実行できた時は本当に嬉しいですね。 また情けない質問をさせて頂くかも知れませんがよろしくお願い致します。 本当にありがとうございました。
補足
ありがとうございます。早速トライさせて頂きます。 前回お教え頂いた事を理解しきれておらず、大変申し訳ございません。
- n-jun
- ベストアンサー率33% (959/2873)
＃１です。 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 やはり間違っておりますでしょうか。。。
お礼
遅くなりまして大変申し訳ございませんでした。 ご丁寧に教えくださりましてありがとうございました。 まだどうして処理が実行されない場合があるのか、よくわかっていないのですが、複数の処理を同時に組み合わせてその問題が起こることがあるようです。 またよろしくお願いいたします。
補足
はい、それが、質問しながら自分でもやってみていたのですが… やっぱりおかしいのでしょうね。セルを選択されるだけで、どれも実行されてくれません。 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 二度も三度も同じようなことを、ほんとに恐縮です。。。