SpecialCellsの困った動作

エクセルで特定セルを参照したいときに使う Range.SpecialCells というメソッド。
このメソッドは「編集(E)」-「ジャンプ(G)」-「セル選択(S)...」と同じに機能する。


マクロでこの機能を使うときに気になる点が2つあって、
一つは引数 Type で指定できる要素が1つだけしかないということ、
これは数式の形式で引数指定できるようにおいおい拡張するつもり。


で、もう一つ、
単一のセルを対象に SpecialCells を実行すると、シート全体が対象となってしまう。
つまり、 Range("A1").SpecialCells(xlTypeConstants) と
Cells.SpecialCells(xlTypeConstants) は同じ意味になる。
これだと、例えば、選択範囲中の特定セルに対して何か処理したいときに、ちょっと困る。


解決するには、
条件分岐で単一のセルの場合用の処理を書く「泥臭い方法」と
あくまで SpecialCells の機能で無理やり実行させる「インチキ臭い方法」がある。
以下はインチキ臭い方法。


できるだけ、泥臭い方法をとらずに、
かつ、やりたい事を実現する方法だけど、
もっとスマートな方法が最初から用意されているのが一番良いと思う。


Option Explicit

Public Sub Usage()

    Dim r As Range
    
    Set r = GetCells(Selection, xlCellTypeConstants)

    If Not r Is Nothing Then
        r.Select
    Else
        MsgBox "none"
    End If
    
    Set r = Nothing

End Sub



Public Function GetCells _
    (ByVal r As Range, ByVal CellType As XlCellType, _
     Optional ByVal Value As XlSpecialCellsValue = _
                        xlTextValues + xlNumbers + xlLogical + xlErrors) As Range
    
    Dim ReturnRange As Range
    
    '# 単一セルの場合、セル範囲を拡張する(シート全体を対象させない)
    Dim t As Range
    If r.Count = 1 Then
        Set t = r
        Set r = Application.Union _
                    (r, r.Cells((r.Row = Cells.Rows.Count) * 2 + 2, 1))
    End If
    
    '# 本当はこの処理がしたいだけなのに..
    On Error Resume Next
        Set ReturnRange = r.SpecialCells(CellType, Value)
    On Error GoTo 0 'こういうエラートラップも本当はないほうがいい
    
    '# 単一セルの場合、拡張したセルが戻り値として帰らないようにする
    If Not (ReturnRange Is Nothing Or t Is Nothing) Then
        Set ReturnRange = Application.Intersect(ReturnRange, t)
    End If
    
    Set GetCells = ReturnRange

End Function