Application.Intersectメソッドを使う

セルが指定した範囲内にあるかどうかを判定するFunction

Application.Intersectメソッドを使う

何気なく日経ソフトウエアの１月号を読んでいたら、武藤玄氏の連載記事「実務ですぐに役立つExcel VBA」の中に、次のような記述があった。

Intersectメソッドは、第1引数のセル範囲が、第2引数のセル範囲に含まれるとき、共有するセル範囲を返します。また、含まれないときは「Nothing」を返します。

ほおぉ～！　知らなかった。当該記事では、このIntersectメソッドを用いて、選択したセルが表の内側にあるか、外側にあるのかの判定に使っていた。

今まで、同じことをWorksheet_SelectionChangeの中で、引数Target(As Range)のRowプロパティやColumnプロパティで条件分岐してやっていたけれど、Intersectメソッドの挙動を利用すれば、もっとスマートにできるということだ。

Function化

ひとまず、簡単に、第１引数で指定したセルが、第２引数で指定した範囲内にあればTrue、なければFalseを返すFunctionにしてみた。

リスト１　標準モジュール

'宣言セクション'
Public Const ERROR_MESSAGE_10007 As String = _
  "isWithinTheRangeメソッドの引数targetCellは、単一のセルとしてください。"
'宣言セクションここまで'

Public Function isWithinTheRange(ByVal targetCell As Range, _
                                 ByVal serchFor As Range) As Boolean    '……(1)'
  With targetCell    '……(2)'
    If .Rows.Count > 1 Or _
       .Columns.Count > 1 Then _
        Err.Raise Number:=10007, _
                  Description:=ERROR_MESSAGE_10007
  End With
  Dim tmpRange As Range
  Set tmpRange = Application.Intersect(targetCell, serchFor)    '……(3)'
  If tmpRange Is Nothing Then    '……(4)'
    'tmpRangeがNothingだったら、範囲内にない。'
    isWithinTheRange = False
  Else
    'tmpRangeにセルが格納されていたら、範囲内にある。'
    isWithinTheRange = True
  End If
  Set tmpRange = Nothing
End Function

まず、(1)の

Public Function isWithinTheRange(ByVal targetCell As Range, _
                                 ByVal serchFor As Range) As Boolean

で引数と返り値の設定。

第１引数には範囲内にあるかどうかを調べたいセル、第２引数には調べる対象のセル範囲を指定する。んで、範囲内にあったらTrue、範囲外だったらFalseを返す。

(2)からの６行（実質３行）

With targetCell    '……(2)'
  If .Rows.Count > 1 Or _
     .Columns.Count > 1 Then _
      Err.Raise Number:=10007, _
                Description:=ERROR_MESSAGE_10007
End With

では、第１引数をチェックし、複数セルになっていたらエラーを吐く。

ここからがメインの処理。

(3)の

Set tmpRange = Application.Intersect(targetCell, serchFor)

でIntersectメソッドを使う。変数tmpRangeには、targetCellがserchForの範囲内にあればtargetCellが格納され、範囲外だったらNothingが格納されることになる。

あとは、(4)からの５行（コメント行除く）

If tmpRange Is Nothing Then    '……(4)'
  'tmpRangeがNothingだったら、範囲内にない。'
  isWithinTheRange = False
Else
  'tmpRangeにセルが格納されていたら、範囲内にある。'
  isWithinTheRange = True
End If

で、tmpRangeの中身に応じて返り値を設定する。

使用例

こんなシートを準備して、そのシートモジュールに次のコードを書いてみる。

リスト２　シートモジュール

下記は修正前のものです。修正後のコードはコチラをどうぞ！

'宣言セクション'
Private Const START_ROW As Long = 1    '……(1)'
Private Const START_COLUMN As Long = 1
'宣言セクションここまで'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Sh As Worksheet
  Set Sh = Target.Parent
  Dim lastRow As Long    '……(2)'
  lastRow = Sh.Cells(Rows.Count, START_COLUMN).End(xlUp).Row
  Dim lastColumn As Long
  lastColumn = Sh.Cells(START_ROW, Columns.Count).End(xlToLeft).Column
  Dim tableRange As Range    '……(3)'
  With Sh
    Set tableRange = .Range(.Cells(START_ROW, START_COLUMN), _
                            .Cells(lastRow, lastColumn))
  End With
  If Not isWithinTheRange(Target, tableRange) Then _
    Call makeUserSick("表の範囲外を選ぶなボケ！")    '……(4)'
End Sub

(1)からの２行

Private Const START_ROW As Long = 1
Private Const START_COLUMN As Long = 1

は、表の開始位置（Ａ１セル、すなわち１行１列目）を定数にしている。表の開始位置が変わったら、定数の定義だけを変更すればよい。

(2)からの４行

Dim lastRow As Long
lastRow = Sh.Cells(Rows.Count, START_COLUMN).End(xlUp).Row
Dim lastColumn As Long
lastColumn = Sh.Cells(START_ROW, Columns.Count).End(xlToLeft).Column

では、表の終端の行・列番号を、おなじみのEndプロパティを使うやり方で求めている。

(3)からの５行（実質４行）

Dim tableRange As Range
With Sh
  Set tableRange = .Range(.Cells(START_ROW, START_COLUMN), _
                          .Cells(lastRow, lastColumn))
End With

では、表全体を一つのRangeオブジェクトとして変数tableRangeにぶち込んだ。別にここまでする必要はないのだけれど……。

あとは、(4)の

If Not isWithinTheRange(Target, tableRange) Then _
    Call makeUserSick("表の範囲外を選ぶなボケ！")

で先ほどのリスト１のisWithinTheRangeメソッドを用いて条件判定し、選んだセル（Target）が表の範囲（tableRange）外にあったら、当ブログではおなじみのmakeUserSickメソッドを呼び出してちょっとむかつくメッセージを表示する、という仕掛けにした。

実行結果

表の範囲外を選択すると、

煽られるｗｗｗ

おわりに

まあ、この程度の使い方なら、「わざわざIntersectメソッドをラップせんでも、そのまま使やいーじゃん」でしょうなあ。

追記

リスト２のコードだと、複数セルを選んだだけでエラーを吐いてしまうので、ちょっと修正する。

リスト２改　シートモジュール

'宣言セクション'
Private Const START_ROW As Long = 1
Private Const START_COLUMN As Long = 1
'宣言セクションここまで'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Sh As Worksheet
  Set Sh = Target.Parent
  Dim lastRow As Long
  lastRow = Sh.Cells(Rows.Count, START_COLUMN).End(xlUp).Row
  Dim lastColumn As Long
  lastColumn = Sh.Cells(START_ROW, Columns.Count).End(xlToLeft).Column
  Dim tableRange As Range
  With Sh
    Set tableRange = .Range(.Cells(START_ROW, START_COLUMN), _
                            .Cells(lastRow, lastColumn))
  End With
  Dim targetCell As Range
  For Each targetCell In Target
    If Not isWithinTheRange(targetCell, tableRange) Then _
      Call makeUserSick("表の範囲外を選ぶなボケ！"): Exit For
  Next
End Sub

これで大丈夫だと思います。

参考

私は、以下のコードをXlCommonと名付けた標準モジュールに入れておいて、インポートしていろんなマクロで使い回していますｗ

makeUserSickメソッド　標準モジュール

'宣言セクション'
Public Const MAKE_USER_SICK_2013 As String = _
              "       ＿＿＿＿＿＿＿" & vbCrLf & _
              "   ／　　　　　　　＼" & vbCrLf & _
              "／　／・＼　　／・＼　＼" & vbCrLf & _
              "|　　￣￣　 　￣￣　　 |　　　ち～ん（笑）" & vbCrLf & _
              "|　　　　（＿人＿）　  |" & vbCrLf & _
              "|　　　　　＼　 |　　　|" & vbCrLf & _
              "＼　　　　　＼_|　　／"

Public Const MAKE_USER_SICK_2010 As String = _
              "    　＿＿＿＿＿＿＿" & vbCrLf & _
              "　／　　　　　　　        ＼ " & vbCrLf & _
              "／　／・＼　　／・＼  　  ＼" & vbCrLf & _
              "|　　￣￣　　　￣　　　      |　ち～んｗ" & vbCrLf & _
              "|　　　　（＿人＿）　　       |" & vbCrLf & _
              "|　　　　　＼ 　   |      　   |" & vbCrLf & _
              "＼　　　　 　＼＿|　      ／"
'宣言セクションここまで'

Public Sub makeUserSick(Optional ByVal msg As String)
  Dim ver As String
  ver = Application.Version
  Dim str As String
  Select Case ver
    Case "14.0"
      str = MAKE_USER_SICK_2010
    Case "15.0"
      str = MAKE_USER_SICK_2013
    Case "16.0"
      str = MAKE_USER_SICK_2013
    Case Else
      str = MAKE_USER_SICK_2010
  End Select
  If msg = "" Then msg = "涙拭けよｗｗｗ"
  MsgBox msg & vbCrLf & str
End Sub