【ExcelVBA】 既にあるマクロの間で実行させたいのです。

質問

こんにちは
下のマクロを・・・

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const RangeName As String = "●入力"

If Not Intersect(Range(RangeName), Target) Is Nothing Then
Cancel = True
If Target = "●" Then
Target = ""
Else
Target = "●"
End If
End If
End Sub

このマクロの■ここで実行■で実行させたいのですが、どのようにしたらよいでしょう。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> "$D$1" Then Exit Sub
Cancel = True
Columns("A:U").Select
Range("T1").Activate
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Selection.Replace What:="ああ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D1").Select
End Sub

■ここで実行■

Private Sub Worksheet_Change(ByVal Target As Range)
strAddress = "A1:A2000"
On Error GoTo ErrorHandler
If Target.Count > 1 Then GoTo ErrorHandler
If Not Intersect(Target, Range(strAddress)) Is Nothing Then
Application.EnableEvents = False
Range(strAddress).ClearContents
Target.Value = "●"
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

回答No.3

Wendy02 · ベストアンサー

こんばんは。

今のままで、二つ（三つ？）のダブルクリック・イベントで動くようにしてください、というのは、まったくロジックが成り立ちません。もう少し、基本的なことに立ち返ったほうがよいと思います。

'ワンクリックに換えました。ワンクリックのほうが入力は楽です。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　On Error GoTo ErrorHandler
　If Target.Count > 1 Then GoTo ErrorHandler
　If Target.Column <> 1 Then GoTo ErrorHandler
　　 Application.EnableEvents = False
　　 Range("a1", Cells(65536, 1).End(xlUp)).ClearContents
　　 Target.Value = "●"
ErrorHandler:
　 Application.EnableEvents = True
End Sub

'D1にダブルクリックすると、起動する
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> "$D$1" Then Exit Sub
Cancel = True
　Target.CurrentRegion.Sort _
　　　　 Key1:=Range("D2"), _
　　　　 Order1:=xlAscending, _
　　　　 Header:=xlYes, _
　　　　 OrderCustom:=1, _
　　　　 MatchCase:=False, _
　　　　 Orientation:=xlTopToBottom, _
　　　　 SortMethod:=xlPinYin, _
　　　　 DataOption1:=xlSortNormal

　Target.CurrentRegion.Replace _
　　　　What:="ああ", _
　　　　Replacement:="", _
　　　　LookAt:=xlPart, _
　　　　SearchOrder:=xlByRows, _
　　　　MatchCase:=False, _
　　　　SearchFormat:=False, _
　　　　ReplaceFormat:=False
End Sub

お礼

こんにちは。
新しいマクロまでご提案いただき有難うございました。大変上手く行きました。
とても使いやすい表ができたと思います。

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

回答No.2

imogasi

ＶＢＡコードの質問には、コードを載せてくださいといってきました。
その通りにしていただいています。その点では結構なんですが。
しかし何をしたいかを文章で添える、親切心がほしい。
長いコード解読させるのだから、コメントでも入れておくとか。
さて本題は
イベントプロシージュアーの中身部分を独立したモジュールにすればようだけのことではないですか。
Ｔａｒｇｅｔの部分は標準モジュールでは引数にして、場合に応じてユーザーがセットしないといけない。
「■ここで実行■で」における、Ｔａｒｇｅｔにあたるものは、何ですか。

お礼

お返事有難うございました。
おかげさまで解決しました。

回答No.1

Wendy02

こんにちは。

＞【ExcelVBA】 既にあるマクロの間で実行させたいのです。

ご質問の意図がはっきりしませんが、一応、コードを読んだ限りでは、もう完成品だと思いますし、これだけ作ったのでしたら、重なる部分を1つにして、後は、DoubleClickイベントのコードの「■ここで実行■」に、コードを付け足せばよろしいと思います。

何か、お分りにならない点があるのですか？

ただ、もし少しコードの評価してよいのでしたら、それ全ては、コマンドボタンなどの種類のマクロで、ワークシートイベントやダブルクリック・イベントとしては、少し大きすぎる気がしています。Changeイベントで、その都度、A1:A2000まで、該当セルにEnterを入れたら、削除して、次に、●を入れるというのは、意味がわかりませんが。

補足

私は殆どマクロの知識がなく、それぞれのマクロをその都度教えてもらったのです。
それぞれは完成して上手く実行できるのですが、これらをつなげて実行しようとすると
コンパイルエラーとなってしまうので、もう一度質問させていただいたのです。

マクロの上に、実行したい事を書いてみました。
尚、「ダブルクリックしたセルに●を付ける」のマクロは変更しました。

「ダブルクリックしたセルに●を付ける」
「A列に●を付けて他のセルの●を消す」は、
一連の動作なのでつなげて実行したいのです。

D1をダブルクリックするとA列からU列までを並べ替え
「ああ」を削除する。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> "$D$1" Then Exit Sub
Cancel = True
Columns("A:U").Select
Range("T1").Activate
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Selection.Replace What:="ああ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D1").Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

ダブルクリックしたセルに●を付ける(●を付けるのはA列のみです。)
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Target.Value = "●"
　Cancel = True
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

A列に●を付けて他のセルの●を消す
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub Worksheet_Change(ByVal Target As Range)
strAddress = "A1:A2000"
On Error GoTo ErrorHandler
If Target.Count > 1 Then GoTo ErrorHandler
If Not Intersect(Target, Range(strAddress)) Is Nothing Then
Application.EnableEvents = False
Range(strAddress).ClearContents
Target.Value = "●"
End If
ErrorHandler:
Application.EnableEvents = True
End Sub