アクティブセルが入力セル範囲内か判定する

入力セル範囲にアクティブセルが含まれるか判定するには

入力セル範囲にアクティブセルが含まれるか判定が必要な場合があります。例えばアクティブセルが基点のなって入力セル範囲の各セルを１つずつ処理するような場合です。

シートの入力セル範囲はUsedRangeプロパティで取得することが出来ます。その中にアクティブセルが含まれているのか確認するにはAddressプロパティを利用します。

方法として２通りのコードを紹介します。

１つは単純に入力セル範囲の１セルずつAddressプロパティを見てActiveCellのAddressと同じかを判定する方法です。入力セル範囲が広くなるほど判定に時間が掛かる欠点があります。

もう１つは入力セル範囲の上下左右の座標内にActiveCellが含まれるかを判定する方法で、こちらの処理速度は常に一定で高速です。

1. 入力セル範囲を１セルずつ判定する方法

入力セル範囲を１セルずつループして、アクティブセルと同じアドレスかどうかを判定する方法です。

処理が簡単なためコードは短いですが、入力セル範囲が広くなるとそれだけループ回数が増えることになります。

ただ、Windows7以降のPCであればCPUが高速なためこちらの処理方式でも問題ない場合がほとんどと思われます。

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

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

IsActiveCellInUsedRange = bExistFlg

End Function

テストコード

上の関数のテストコードです。

Sub IsActiveCellInUsedRangeTest()
    Debug.Print IsActiveCellInUsedRange
End Sub

Sub IsActiveCellInUsedRangeTest()

Debug.Print IsActiveCellInUsedRange

End Sub

以下の図は入力セル範囲が赤枠内になります。そのため、アクティブセルが赤枠内にあればTrueが返り、赤枠の外にあればFalseが返ります。

2. 高速に入力セル範囲にアクティブセルが含まれるか判定する方法

高速にアクティブセルが入力セル範囲に含まれるか判定する関数です。

Addressプロパティの値をR1C1形式で取得すると「R1C1:R5C8」のような値になります。

それをコロンで分割し、開始セルと終了セルに分けて、さらにそれぞれの行と列を取得し、その範囲にアクティブセルの行と列が含まれるかを判定しています。

それらの分割処理でコードが長くなりますが、入力セル範囲に関係なく処理されますので処理速度は常に一定です。

使い方は上のコードと同じため省略します。

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

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

入力セル範囲にアクティブセルが含まれるか判定するには

1. 入力セル範囲を１セルずつ判定する方法

テストコード

2. 高速に入力セル範囲にアクティブセルが含まれるか判定する方法

関連記事