入力セル範囲にアクティブセルが含まれるか判定するには
入力セル範囲にアクティブセルが含まれるか判定が必要な場合があります。
例えばアクティブセルが基点のなって入力セル範囲の各セルを１つずつ処理するような場合です。
シートの入力セル範囲はUsedRangeプロパティで取得することが出来ます。
その中にアクティブセルが含まれているのか確認するにはAddressプロパティを利用します。
方法として２通りのコードを紹介します。
１つは単純に入力セル範囲の１セルずつAddressプロパティを見てActiveCellのAddressと同じかを判定する方法です。入力セル範囲が広くなるほど判定に時間が掛かる欠点があります。
もう１つは入力セル範囲の上下左右の座標内にActiveCellが含まれるかを判定する方法で、こちらの処理速度は常に一定で高速です。
1. 入力セル範囲を１セルずつ判定する方法
入力セル範囲を１セルずつループして、アクティブセルと同じアドレスかどうかを判定する方法です。
処理が簡単なためコードは短いですが、入力セル範囲が広くなるとそれだけループ回数が増えることになります。
ただ、Windows7以降のPCであればCPUが高速なためこちらの処理方式でも問題ない場合がほとんどと思われます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
Function IsActiveCellInUsedRange() As Boolean Dim r As Range Dim bExistFlg As Boolean bExistFlg = False '// 入力セル範囲を１セルずつループ For Each r In ActiveSheet.UsedRange '// 現ループセルとアクティブセルのアドレスが同じ場合 If r.Address = ActiveCell.Address Then '// 入力セル範囲にアクティブセルが存在するとみなす bExistFlg = True Exit For End If Next IsActiveCellInUsedRange = bExistFlg End Function |
テストコード
上の関数のテストコードです。
|
1 2 3 |
Sub IsActiveCellInUsedRangeTest() Debug.Print IsActiveCellInUsedRange End Sub |
以下の図は入力セル範囲が赤枠内になります。そのため、アクティブセルが赤枠内にあればTrueが返り、赤枠の外にあればFalseが返ります。
2. 高速に入力セル範囲にアクティブセルが含まれるか判定する方法
高速にアクティブセルが入力セル範囲に含まれるか判定する関数です。
Addressプロパティの値をR1C1形式で取得すると「R1C1:R5C8」のような値になります。
それをコロンで分割し、開始セルと終了セルに分けて、さらにそれぞれの行と列を取得し、その範囲にアクティブセルの行と列が含まれるかを判定しています。
それらの分割処理でコードが長くなりますが、入力セル範囲に関係なく処理されますので処理速度は常に一定です。
使い方は上のコードと同じため省略します。
|
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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
Function IsActiveCellInUsedRange2() As Boolean Dim bExistFlg As Boolean '// ActiveCellが入力セル範囲に含まれるか判定フラグ Dim v '// セル範囲の:をSplit分割用 Dim vStart '// セル範囲の開始セルアドレスを行と列で分割 Dim vEnd '// セル範囲の終了セルアドレスを行と列で分割 Dim sAddress As String '// Addressプロパティ値 Dim iRowTop As Long '// 入力セル範囲の一番上の行 Dim iRowBottom As Long '// 入力セル範囲の一番下の行 Dim iColLeft As Long '// 入力セル範囲の一番左の列 Dim iColRight As Long '// 入力セル範囲の一番右の列 Dim iRow As Long '// アクティブセルの行 Dim iCol As Long '// アクティブセルの列 '// 入力セル範囲のアドレスを取得 sAddress = ActiveSheet.UsedRange.Address(ReferenceStyle:=xlR1C1) '// 2つ以上のセルの場合 If (InStr(1, sAddress, ":") > 0) Then '// コロンで分割して開始セルと終了セルに分ける v = Split(sAddress, ":") '// R1C1形式アドレスの"R"を除去して"C"で分割 vStart = Split(Replace(v(0), "R", ""), "C") vEnd = Split(Replace(v(1), "R", ""), "C") '// 座標取得 iRowTop = vStart(0) iRowBottom = vEnd(0) iColLeft = vStart(1) iColRight = vEnd(1) '// 1セルのみ入力されている場合 Else '// セルアドレスの"R"を除去して"C"で分割 vStart = Split(Replace(sAddress, "R", ""), "C") '// 座標取得 iRowTop = vStart(0) iRowBottom = vStart(0) iColLeft = vStart(1) iColRight = vStart(1) End If '// アクティブセルの座標を取得 sAddress = ActiveCell.Address(ReferenceStyle:=xlR1C1) vStart = Split(Replace(sAddress, "R", ""), "C") iRow = vStart(0) iCol = vStart(1) '// アクティブセルが入力セル範囲外の場合 If (iRow < iRowTop Or iRow > iRowBottom Or iCol < iColLeft Or iCol > iColRight) Then bExistFlg = False Else bExistFlg = True End If IsActiveCellInUsedRange2 = bExistFlg End Function |