• ベストアンサー

認識するイベントの範囲を制限したい。(VBA)

エクセルのVBAではchangeイベントやselection_changeイベントでは、シート全体に対するイベントが実行されると思うのですが、それを自分の決めた範囲のみに対するイベントのみをとりたいのですが、どうしたらいいでしょうか? 便利な何かがあればいいのですが、取りあえず原始的に、ある範囲のrowやrows.count、columnやcolumns.countを使ってtargetがその中にあるかどうかとゆう方法でやりました。もっと簡単にできないでしょうか? よろしくお願いします。

  • rufas
  • お礼率75% (315/420)

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

  • ベストアンサー
  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.3

>取りあえず原始的に、ある範囲のrowやrows.count、columnやcolumns.countを使って >targetがその中にあるかどうかとゆう方法でやりました。 >もっと簡単にできないでしょうか? 当然、rowやcolumnを使って範囲を特定することも行いますが、範囲の形状で面倒になったりします。 普通行っているのは、  自分の決めた範囲を定義する。離れた範囲や複雑な範囲は『Union』で定義すると効果的。   ↓  Targetを単一セル単位で処理   ↓  単一セルが自分の決めた範囲にあれば処理を行う。『Intersect』を使い、判定を行う。 範囲の行数・列数の計算や判定回数が減り、分かりやすく書ける気がします。。 こんな感じで書いています。 Private Sub Worksheet_Change(ByVal Target As Range)   Dim rg As Range '変更したセル   Dim myArea As Range 'この範囲で何かを行う   Set myArea = Union(Range("B2:B5"), Range("C6:C9"), Range("D10:D13"))   For Each rg In Target     If Not Intersect(myArea, rg) Is Nothing Then       MsgBox "Hit!!"     End If   Next End Sub

rufas
質問者

お礼

有難うございます。聞きなれないUnionやIntesectとゆうのがでてきたので、早速調べてこの方法でプロトタイプを作ってみようと思います。

rufas
質問者

補足

補足ではないのですが、どうしてもわからないことがありましたので・・・ > If Not Intersect(myArea, rg) Is Nothing Then この一文なのですが、Is Nothingがよくわかりませんでした、いろいろ調べてみましたが、参照しなくなるとか利用できなくなるとか書いていました。Intersectは共通部分と書いていましたので、Not Intersect(myArea, rg) だとmyAreaと rg の共通部分ではないところとゆう感じでしょうか? のIs Nothing とはどのような意味になるのでしょか?       

その他の回答 (3)

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.4

Intersectメソッドの使用例(Help)には、   Worksheets("Sheet1").Activate   Set isect = Application.Intersect(Range("rg1"), Range("rg2"))   If isect Is Nothing Then     MsgBox "共通部分がありません。"   Else     isect.Select   End If とあります。 この、『isect Is Nothing』は、Is演算子で2つのオブジェクト変数(isect と Nothing)を比較して、 2つが同じならTrueが返ってきます。『=』の代入の意味ではありません。 この場合、片方がNothingなので、式がTrueならisectもNothingになり、共有セル範囲が存在しないことになります。 ここで気になるのが、『Nothing』って何?ということですが、DimステートメントのHelpに、  『・・・宣言したオブジェクト変数にオブジェクトが代入されるまでは、その変数には Nothing という   特殊な値が設定されます。Nothing は、その変数がオブジェクトの特定のインスタンスを参照していない   ことを示します。』とあります。 個人的には、『Is Nothing』はIntersectやFindで『共有部分がない、見つからない』の意味で使っています。 上のような書き方を、個人的には下のように書いています。   If Not Intersect(myArea, rg) Is Nothing Then 日本語表現では『共有部分がないということでなければ』でしょうか。 この式の『Not Intersect(myArea, rg) Is Nothing』を考えます。   Not演算子は式の論理否定を求めます。   従って、Notに対応する式は Intersect(myArea, rg) Is Nothing になります。     この式の意味はHelpと同様、Intersect(myArea, rg) と Nothing を比較して     一致したらTrue(と言うことは、Intersectした結果がNothing=何もない)です。    Intersect(myArea, rg) で2つのセル範囲の共有部分を求める       ↓    Intersect(myArea, rg) Is Nothing          で共有部分がなかったら式はTrueになる          で共有部分ががあれば式はFalseになる       ↓    Not Intersect(myArea, rg) Is Nothing          で共有部分がなかったら式はFalseになる          で共有部分ががあれば式はTrueになる          分かりやすく書くと Not(Intersect(myArea, rg) Is Nothing) です。       ↓    結局、共有部分があれば、Ifの判別式はTrueになります。

rufas
質問者

お礼

有難うございました。大変わかりやすかったです!! よくわかりました。いろんなところで使えそうですね。行と列をそれぞれみるより断然こっちの方が読解性がありますね。 ほんとにお世話になりました。有難うございました。

rufas
質問者

補足

あ~ほんとに何回も申し訳ありません。rgとゆうのはどの部分のことでしょか? Targetが一つのセルではなく広い範囲だとして、その中のセルを一つずつみるとゆうことで、For文でセルの数だけまわしているのでしょうか? 私は範囲が一列と31行だったので、For文を使わずに Public Function M_isArea(ByVal target As Range) Dim my_area As Range M_isArea = False Set my_area = Range("入社退社")←31行1列です。 If Not Intersect(target, my_area) Is Nothing Then M_isArea = True End If End Function としてみましたが、大丈夫ですか?動かした感じは大丈夫そうなのですが・・・ rgとはなんだったのでしょうか?申しわけありません。よろしくお願いします。

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.2

えーとですねー Hook=引っ掛ける ですよね? VBやVBAにはそれぞれイベントがあります。 それはなぜ起こるかというと、OSとアプリケーションとの間でメッセージのやり取りがあるからです。 それをアプリケーションが現状を認識しチェンジイベントなどを起こします。 そのOSとアプリケーションとのやりとりのメッセージを盗み見たり、変更させてしまうのです。 それが俗にHookと呼ばれています。 ここの質問掲示板にもHookを使用した例をいくつか載せてますので、見てみると面白いかもしれませんね ^^

rufas
質問者

お礼

なるほど~。そんなマニアックな技が存在するのですね~。とても私にはできそうにもないですね。有難うございました。

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.1

>自分の決めた範囲のみに対するイベントのみをとりたい 無理と思われます。 イベント発生はエクセル内部のシートオブジェクトで行われている物です。 イベントはオブジェクト単位で発生します。 一度エクセルシートをHookさせようとしたことがあるのですが、共有メモリ部分を参照しようとすると、EXCELが以上終了を連発しました。 もしこの方法が成功しても明らかに面倒な方法です。おすすめできません。 >ある範囲のrowやrows.count、columnやcolumns.countを使ってtargetがその中にあるかどうか それが最適な方法です。 範囲にあるかどうかをチェックするロジックを作っておき、その関数がTRUE/FALSEを返す仕組みにしておくことが、一番簡潔な方法だと思います。

rufas
質問者

お礼

有難うございます。やはり無理なのですね。それがわかっただけでも良かったです。そうですね、TAGOSAKU7さんの教えてくださったようにやっていましたので、それを自分の関数としてあちらこちらで使いまわししたいと思います。 ところで、Hookとは何でしょうか?プログラム初心者(パソコン自体初心者です)なもので、よくわかりませんでした。

関連するQ&A

  • excel VBA のコードを編集したい

    下記VBAのコードですが、「選択範囲をCSVファイルにしてカレントフォルダに出力する」というものですが これを編集して、どのパソコンでもデスクトップに出力すると編集したいです。 どのようにコードを変更したらいいか、教えていただけないでしょうか?自分ではどうがんばっても変更できそうにありませんでした。 どうかよろしくお願いいたします。 Sub Selection_CSV_Output() 'ファイル名をINPUTBOXで取得 '選択範囲を調べる '選択範囲の左上から1列づつ最終列までセルの値を取得しカンマを付加した文字列を作成 '1行分の文字列の最後カンマを削除し、改行コードを付加する '行数分だけ繰り返す 'CSVファイルとして、出力 '確認メッセージをMSGBOXで表示 'テストバージョン Dim myInBox As String Dim start_row, start_column, end_row, rows_count, columns_count, end_column As Long Dim SaveD, d As String Dim CsvF_name, cellD As String Dim i, j As Long 'InputBoxでファイル名指定 myInBox = Application.InputBox(Title:="ファイル名", prompt:="拡張子なしのファイル名を入力してください", Default:="001", Left:=100, Top:=100, Type:=2) If myInBox = "False" Then Exit Sub 'Debug.Print myInBox 'ファイル名 CsvF_name = myInBox & ".csv" '範囲を調べる start_row = Selection.Row '開始行 start_column = Selection.Column '開始列 end_row = start_row + Selection.Rows.Count - 1 '終了行 end_column = start_column + Selection.Columns.Count - 1 '終了列 rows_count = Selection.Rows.Count '範囲行数 columns_count = Selection.Columns.Count '範囲列数 '読み込みと出力 Open CsvF_name For Output As #1 For i = start_row To start_row + Selection.Rows.Count - 1 '行の繰り返し For j = start_column To end_column '列の繰り返し cellD = Cells(i, j).Value SaveD = SaveD & cellD & "," 'カンマを付加 Next j '列の終わり SaveD = Left(SaveD, Len(SaveD) - 1) '最後の一文字(カンマ)を消す SaveD = SaveD & vbCrLf '改行コードを付加 'Debug.Print SaveD Next i 'Debug.Print SaveD Print #1, SaveD Close #1 '確認メッセージ MsgBox CsvF_name & "名でカレントフォルダに作成しました。" End Sub

  • VBAのセルの色の設定について

    EXCEL・VBAにて.Interior.Color=RGB(152, 251, 152)と設定しましたが 思った色(緑系の色)ではなくグレー系の色になってしまったのですが、 何か間違っているのでしょうか? 何かわかる方いらっしゃいますでしょうか? 実際のソースはしたの通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False 'ステータス欄の入力の判断 Select Case Target.Value Case "あああ" Worksheets("シート1").Rows(Target.Row).Interior.Color = RGB(152, 251, 152) Case "いいい" Worksheets("シート1").Rows(Target.Row).Interior.Color = RGB(254, 208, 224) Case "ううう" Worksheets("シート1").Rows(Target.Row).Interior.Color = RGB(255, 255, 0) Case "えええ" Worksheets("シート1").Rows(Target.Row).Interior.Color = RGB(192, 192, 192) Case Else Worksheets("シート1").Rows(Target.Row).Interior.Color = RGB(255, 255, 255) End Select Application.EnableEvents = True End Sub

  • VBA一定の範囲内からデータが入っている行を検索

    現在VBAにて作成中です。 内容は、各シートの全く同じ範囲内から1シートへ自動で貼り付けを行い日付順に並べ替えるということです。 各シートは全て同じ表になっていますので、コピー範囲のセル番地は全シート同じです。 コピー範囲は、BF4:BM81で、BF4に日付が入っています。 81行までありますが、82行には、合計行が入っていることや、その下行もデータが入っている為、範囲指定をしています。また、81行設けていますが、上から順にデータは入っているものの、81行まで全て埋まっているとは限りません。 その為、下記のVBAにすると、各シートの81行までのデータが反映され1シートに全てのシート分が貼り付けられるので、かなりの行数になり、空白や0の行が出てしまいます。 範囲内から日付(列BF)のデータが入っている行までを検索し選択、貼り付けを行えるようにしたいと思っています。 どなたかご教授頂ければと思いますのでよろしくお願い致します。 見よう見まねで下記を作成しました。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow4 As Long Application.ScreenUpdating = False '----全データシートの有無をチェックします sh_check '----列見出しをコピーします Worksheets(2).Range("bf1:bm3").Copy Worksheets(1).Range("A1") For i = 2 To Worksheets.Count With Worksheets(i) 左上 = "Bf4" 右下 = "bm81" 範囲 = 左上 & ":" & 右下 lRow = .Cells(Rows.Count, 1).End(xlUp).Row lCol = .Cells(58, Columns.Count).End(xlToLeft).Column '----シートのデータが4行以上の場合にコピーします If lRow >= 4 Then lRow4 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 .Activate Range(範囲).Select Selection.Copy Worksheets(1).Cells(lRow4, 1).PasteSpecial Paste:=xlPasteValues End If End With Next i End Sub 説明に不足がありましたら、追って書き込みさせていただきます。

  • VBAでChangeイベントを使いたい

    今エクセルで出納を作ってます。 シート1には A日付 Bコード C金額 D 消費税区分 E 金額 F,G,H,Iにも同様に貸方科目を入れてます。 シート2にはAコードB科目を上から下にずっといれてます。 それで借方金額Cの金額をEに飛ばすこと VLOOKUPでBのコードに対応する科目を表示すること 上記をChangeイベントでやりたいのですが、金額転記はうまくいったのですが、 VLOOKUPの方が標準モジュールではうまくいくものの、シートモジュールに移すとうまく 行きません。おそらく根本的な理解がかけてるからだと思います。 今の記述は下記 シート1に Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 5 Then Exit Sub Dim Cnt As Long For Cnt = 2 To 100 Range("I" & Cnt).Value = Range("E" & Cnt).Value Next Cnt If Target.Row = 1 Or Target.Row > 100 Then Exit Sub If Target.Column <> 3 Then Exit Sub End Sub 標準モジュールに Option Explicit Sub 科目() Dim シート1 As Worksheet Dim シート2 As Worksheet Set シート1 = Worksheets("出納") Set シート2 = Worksheets("科目") Dim myR On Error GoTo ErrorHandler myR = Application.WorksheetFunction.VLookup(シート1.Range("B2"), シート         2.Range("A2:B87"), 2, False) シート1.Range("C2").Value = myR Exit Sub ErrorHandler: シート1.Range("C2").Value = "該当無し" End Sub  大変素人な質問ですみませんが、ご回答いただけると嬉しいです。  基礎の本やレファレンス本は見たのですが、標準モジュールでできること  がなぜシートモジュールでできないかが全く分かりません。  よかったらお教えください。

  • VBA changeイベントを複数入れたい

    VBA changeイベントを複数入れたい VBAは初心者で、以前もこちらでお世話になりました。 F4セルに入力した際、VLOOKUPで検索し、該当がなければメッセージボックスを出し、 該当があれば、そのまま次に進む、というchangeイベントが既にあります。 ここに、E4セルに入力した数字が、同じシートのE列5行目以下と重複していた場合、 エラーメッセージを出す、とのをつけたしたいと思っています。 IFを使えばいい、ということはわかるのですが、どこに入れたらいいのかがわからず・・・。 すでにあるVBAは以下のとおりです。 Private Sub Worksheet_Change(ByVal Target As Range) '処分受託者(入力用名称)を入力して、処分業者名簿になければエラーメッセージを出す。 Dim rang1 As Range Dim rang2 As Range Dim 処分受託者名称 As String Dim LastRow As Long LastRow = Worksheets("処分業者名簿").Cells(Rows.Count, "b").End(xlUp).Row Set rang2 = Worksheets("処分業者名簿").Range("b4:b" & LastRow) Set rang1 = Range("f4") If Intersect(Target, rang1) Is Nothing Then Exit Sub On Error Resume Next 処分受託者名称 = WorksheetFunction.VLookup(Target.Value, rang2, 1, 0) If Err.Number > 0 Then MsgBox Target.Value & " はありません" Range("f4").Select Else End If End Sub この、どこに重複の場合はエラーメッセージを出す、というのを入れればいいのか、 教えてください・・・。

  • VBAのchangeイベントについて

    初質問&VBA初心者のため記述が変なところがあると思いますがご了承ください。 現在changeイベントを使用してイメージした通りに動いてくれている(中身はぐちゃぐちゃですが・・・)のですがこれをすべてのシートでも機能するようにしたいのですが何かいい方法はないでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub rc = MsgBox("納車日を更新してもよろしいですか?", vbYesNo + vbQuestion, "確認") If rc = vbYes Then MsgBox "納車日を更新しました" RID = ActiveSheet.Name Set b = Worksheets("シート名").Cells.Find(What:=RID) RID_height = Worksheets("シート名").Cells.Find(RID).Row RID_width = Worksheets("シート名").Cells.Find(RID).Column ThisWorkbook.Worksheets("シート名").Cells(RID_height, 10).Value = Date Else MsgBox "処理を中断します" End If End Sub

  • VBAでのセルの複数選択時の処理について

    現在EXCEL VBAである行の値が変わったときにその列の塗りつぶしの 色を変えるといった処理を作成しております。 そこで、複数選択して値を変えた場合の処理が変数の型が一致しません 的なエラーが表示されてしまいます。 どのように修正したらうまくいくでしょうか? 教えてください。 ソースは下記の通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False MsgBox (Target.Rows.Count) Dim rngSelectRng As Range For Each rngSelectRng In Target If rngSelectRng.Value = "" Then rngSelectRng.Value = " " 'ステータス欄の入力の判断 'Select Case Target.Rows.Value MsgBox (Target.Row) Select Case rngSelectRng.Value Case "あああ" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 24 Case "いいい" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 35 Case "ううう" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 38 Case "えええ" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 36 Case "おおお" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 16 Case Else Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 2 End Select Next Application.EnableEvents = True End Sub

  • シート内の特定のセルの範囲が変化した時、

    シート内の特定のセルの範囲が変化した時、 まずA列の最大値を求めて、その後A列とD列のそれぞれの条件にあった行のA列に 最大値+1を表示させるようにしたいのですが動作しません。 なぜ動かないか教えて下さい。 参考までに、そのプログラムを記載します。 宜しくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row <= 3 Or Target.Row > 65000 And Target.Column = 4 Then Dim i, j, max As Integer max = 0 For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row If max < Range("A" & i).Value Then max = Range("A" & i).Value End If Next i For j = 3 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(j, 1) = "" And Not Cells(j, 4) = "" Then Cells(j, 1) = max + 1 End If Next j End If End Sub

  • WorkSheetのChangeイベントの引数

    WorkSheetオブジェクトのChangeイベント ある教材で、TargetがC3のケースを表現する際、 If Target .Row = 4 And .Column = 3 Then と有った。 回りくどい書き方に見えるのですが、他に表現方法は無いのでしょうか。 この書き方には、何か、理由が有るのでしょうか。 宜しくお願い致します。

  • VBAコピー範囲について教えてください。

    VBAのコピーペーストの下記プログラムで、 Sub コピー() Dim rng As Range Set rng = Worksheets("2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) With Range("b2:J10") rng.Resize(.Rows.Count, .Columns.Count).Value = .Value End With End Sub コピー範囲 のJ10の部分(データ入力行)が、その都度変わるため、J10の部分を、 J列のデータが入力されている最終行としたいのですが、どのようなプログラムに すればよいのでしょうか。 どなたかよろしくお願いいたします。