EXCEL VBA アクティブセルが範囲内に含まれているかの判定・指定した範囲内のセル変更の判定（Intersect）
EXCEL VBA アクティブセルがセル範囲内に含まれているかの判定・指定した範囲内のセル変更されたかの判定（Intersectメゾット）
今回説明するのは、指定したセルが範囲内に含まれているかを判定するIntersectメゾットの利用方法を説明いたします。通常の使い方では複数のセル範囲を指定して重なっている部分のセル位置を取得する時に使用します。また、イベントプロシージャと組み合わせることにより、特定のセルを変更した時に処理を実行するなど様々な所で利用する事が出来ます。それでは、サンプルプログラムを交えて順番に説明致します。
●【Intersectメゾットの活用方法が記載されていますので、下記を参照して下さい】
●【Intersectメゾット (Excel)、下記を参照して下さい】（Microsoft社 様）】
https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.intersect
● Intersectメゾットを利用するには、下記の通りに設定を行います。
・ オブジェクト.Intersect(Arg1,Arg2,Arg3,…..Arg30) ※Arg・・・セル範囲
【使用例①】
・ 下記の使用例は、２つのセル範囲 ・セル範囲「A1～C5」とセル範囲「B4～D8」の重なっているセル範囲を取得する方法です。
Intersect(Range(“A1:C5”), Range(“B4:D8”))
【サンプルプログラム】
|
1 2 3 4 5 6 7 8 9 10 11 12 |
' ' Sub Intersect00() '２つのセル範囲の重なっている部分のセル範囲を取得 Dim RngMix As Range Set RngMix = Intersect(Range("A1:C5"), Range("B4:D8")) MsgBox RngMix.Address End Sub ' |
【使用例②】
・ 下記の使用例は、アクティブセルの位置が指定したセルの範囲内か判定するサンプルプログラムです。Applicationオブジェクト・Intersectメゾットを利用する事で判定する事ができます。指定範囲をセル（A1～C5）を指定範囲内として、それ以外を指定範囲外としてアクティブセルセル位置に対して判定します。
【サンプルプログラム】
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
' ' Sub Intersect01() '２つのセル範囲の重なっている部分のセル範囲を取得 Dim SetRng, WithRng As Range Set WithRng = Range("A1:C5") '指定範囲として設定セル（A1～C5) Set SetRng = Application.Intersect(ActiveCell, WithRng) 'アクティブセルが範囲内か範囲外か判定 If SetRng Is Nothing Then MsgBox "指定範囲外" Else MsgBox "指定範囲内" End If End Sub ' |
EXCEL VBA セル範囲内のセル内容を変更したら実行・入力後に処理実行（Intersectメゾット）
下記のサンプルプログラムは、指定したセルの範囲内のセルの内容を変更した時に、処理を実行するサンプルプログラムです。下記のプログラムではマスターデータとなる人事台帳の内容を登録・変更等、行った際に担当者の変更履歴が分かるように、登録データ単位で、担当者・日時・変更場所を記録します。それでは、順番に説明いたします。
●下記のプログラムは、シートモジュールのイベントプロシージャ「Worksheet change」に登録します。
【プログラムの流れ】
① 指定範囲として列（A列～E列）を指定します。（この範囲を変更した時に処理を実行します。）
② 現在のアクティブセルが指定範囲内（A列～E列）か指定範囲外か判定します。
③ 判定の結果、アクティブセルが（A列～E列）以外の場合は、何もしない。（プログラム終了）
④ 判定の結果、アクティブセルが（A列～E列）以内の場合は、以下の処理を実行します。
⑤ アクティブセルの行番号を取得します。
⑥ アクティブセルの列番号を取得します。
⑦ イベント発生を無効化します。※無効化しないと⑧⑨⑩の処理がイベントプロシージャー「Worksheet Change」に反応してしまい無限ループするため。
⑧ セル（G列）にEXCELアプリケーション・ユーザー名を転記します。※変更したユーザー
⑨ セル（F列）に現在の日時を転記します。※変更日時
⑩ セル（H列）に変更した項目を転記します。※社員番号・氏名・カタカナ・生年月日のいずれかの変更項目
⑪ イベント発生の有効化に戻します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
' ' Private Sub Worksheet_Change(ByVal Target As Range) '更新データの記録 Dim SetRng, WithRng As Range Dim I,ば会う L As Long Set WithRng = Range("A:E") '指定範囲として列（A列～E列）を指定します。 Set SetRng = Application.Intersect(ActiveCell, WithRng) 'アクティブセルが範囲内か範囲外か判定 If SetRng Is Nothing Then '指定範囲内か判定します。（A列～E列） Exit Sub '範囲外は、プログラムから抜けます。 Else '---範囲内の処理--- I = ActiveCell.Row 'アクティブセルの行を取得します。 L = ActiveCell.Column 'アクティブセルの列を取得します。 Application.EnableEvents = False 'イベント発生の無効化 Cells(I - 1, "G") = Application.UserName 'EXCELアプリケーションユーザー名をG列に転記 Cells(I - 1, "F") = Now '現在の日時をF列に転記 Cells(I - 1, "H") = Cells(1, L) '変更した項目（社員番号・氏名・カタカナ・生年月日）を転記 Application.EnableEvents = True 'イベント発生の有効化 End If End Sub ' |
（画面クリックして拡大）
EXCEL VBA セル範囲内の選択セルのをハイライト表示（目立たせる強調）します。（Intersectメゾット）
下記のサンプルプログラムでは、指定したセル範囲内のセル（行・列）をハイライト表示させるサンプルプログラムです。Intersectメゾッドは選択したセルが指定したセル範囲内か判定する時に使用します。指定範囲を指定する事で、範囲外のセルを選択した時は、何もしない（ハイライト表示しない）処理を行います。それでは、サンプルプログラムを交えて順番に説明致します。
●下記のプログラムは、シートモジュールのイベントプロシージャ「Worksheet SelectionChange」に登録します。
【プログラムの流れ】
① セル(C3)を起点とする表の範囲を取得して見出し部分の行１・列１分取得する範囲をずらします。
② ①で取得した表の範囲部分のずらした行１・列１部分が表の範囲からはみ出すので、表の範囲部分の行の最終行と最終列をー１にして、表範囲を揃えます。（数値部分のみを表範囲に指定します）
③ 現在のアクティブセルが表の範囲内か判定します。アクティブセルの数値部分は、④へ：数値部分以外は、このプログラムから抜けます。
【アクティブセルが範囲内の場合以下処理を実施】
④ 表の範囲のハイライト表示させる先頭行を代入
⑤ 表の範囲のハイライト表示させる最終行を代入
⑥ 表の範囲のハイライト表示させる先頭列を代入
⑦ 表の範囲のハイライト表示させる最終列を代入
⑧ 現在のアクティブセルの選択行の行番号を代入
⑨ 現在のアクティブセルの選択列の列番号を代入
⑩ 画面の更新を停止します。
⑪ 表の範囲（数値部分）のセルの背景色を消します。
⑫ 現在のアクティブセル位置にある選択行の背景色をグリーンに塗りつぶします。
⑬ 現在のアクティブセル位置にある選択列の背景色をグリーンに塗りつぶします。
⑭ 画面の更新を再開します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 |
' ' Private Sub Worksheet_SelectionChange(ByVal Target As Range) '選択範囲を指定した行列のハイライト表示 Dim sRow, lRow, sCol, lCol, nRow, nCol As Long Dim RngSet As Range Set RngSet = Range("C3").CurrentRegion.Offset(1, 1) 'セルC3を起点とする表の範囲を取得して見出し部分の行１・列１分範囲をずらします。 Set RngSet = RngSet.Resize(RngSet.Rows.Count - 1, RngSet.Columns.Count - 1) '上でずらした表範囲の最終行と右側部分を－1にして、表範囲を揃えます。 If Not Application.Intersect(ActiveCell, RngSet) Is Nothing Then '表の範囲（数値部分）以外は、このプログラムから抜けます。 sRow = RngSet.End(xlUp).Row + 1 '表の範囲のハイライト表示させる先頭行を設定 lRow = RngSet.End(xlDown).Row '表の範囲のハイライト表示させる最終行を設定 sCol = RngSet.End(xlToLeft).Column + 1 '表の範囲のハイライト表示させる先頭列を設定 lCol = RngSet.End(xlToRight).Column '表の範囲のハイライト表示させる最終列を設定 nRow = Target.Row '現在の選択行の行番号を代入 nCol = Target.Column '現在の選択列の列番号を代入 Application.ScreenUpdating = False '画面の更新を停止する。 RngSet.Interior.ColorIndex = 0 'ワークシート上のセル（A4～L23）の背景色を消す。 Range(Cells(sRow, nCol), Cells(lRow, nCol)).Interior.Color = vbGreen '現在の選択行の背景色を緑に塗りつぶします。(指定範囲内) Range(Cells(nRow, sCol), Cells(nRow, lCol)).Interior.Color = vbGreen '現在の選択列の背景色を緑に塗りつぶします。(指定範囲内 Application.ScreenUpdating = True '画面の更新を再開する End If End Sub ' ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。