2010年6月19日土曜日

【Excel】無駄な選択範囲を縮める④【VBA】

 再チャレンジ。

 "UsedRange"よりも大きな範囲が与えられた場合に"UsedRange"よりも外側の範囲を除いた"Range"を返す関数です。
Sub HowToUse()
    xUsedRange(Selection).Select
End Sub

Private Function xUsedRange(a1 As Range) As Range
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    With ActiveSheet.UsedRange
        ur1 = .Row
        uc1 = .Column
        ur2 = .Rows.Count + ur1 - 1
        uc2 = .Columns.Count + uc1 - 1
    End With
    
    If (r1 > ur2) Or (c1 > uc2) Or (r2 < ur1) Or (c2 < uc1) Or (ur2 = 1) Or (uc2 = 1) Then
        NewRow1 = r1
        NewColumn1 = c1
        NewRow2 = r1
        NewColumn2 = c1
        
        GoTo xxx
    End If
    
    If r1 < ur1 Then
        NewRow1 = ur1
    Else
        NewRow1 = r1
    End If
    
    If c1 < uc1 Then
        NewColumn1 = uc1
    Else
        NewColumn1 = c1
    End If
    
    If r2 > ur2 Then
        NewRow2 = ur2
    Else
        NewRow2 = r2
    End If
    
    If c2 > uc2 Then
        NewColumn2 = uc2
    Else
        NewColumn2 = c2
    End If
    
xxx:
    Set xUsedRange = Range(Cells(NewRow1, NewColumn1), Cells(NewRow2, NewColumn2))
End Function
 "UsedRange"の外側が与えられた場合は、その範囲の左上隅のセル一個を範囲として返す仕様にしました。
【2011/06/01追記】
 xUsedRange関数で、一行目のみ或いは一列目のみを選択した際にA1セルのみを返してしまうと言うバグを発見。「ur2 = 1」と「uc2 = 1」と言う判定ロジックがまずかった。判定ロジックを「a1.Address = "A1"」に変えればOK。修正版のコードは後日…(^_^;)

0 件のコメント:

コメントを投稿