2010年6月16日水曜日

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

 "UsedRange"よりも大きな範囲が与えられた場合に"UsedRange"よりも外側の範囲を除いた"Range"を返す関数です。
 2010年6月13日日曜日2010年6月14日月曜日のコードを実行する前にこのコードを実行すれば、データの有無を調べる範囲が縮まって、更なる高速化が望めるはずです。
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 ur1 = 1 Then
        NewRow1 = 1
    ElseIf r1 < ur1 Then
        NewRow1 = ur1
    Else
        NewRow1 = r1
    End If
    
    If uc1 = 1 Then
        NewColumn1 = 1
    ElseIf c1 < uc1 Then
        NewColumn1 = uc1
    Else
        NewColumn1 = c1
    End If
    
    If ur2 = 1 Then
        NewRow2 = 1
    ElseIf r2 > ur2 Then
        NewRow2 = ur2
    Else
        NewRow2 = r2
    End If
    
    If uc2 = 1 Then
        NewColumn2 = 1
    ElseIf c2 > uc2 Then
        NewColumn2 = uc2
    Else
        NewColumn2 = c2
    End If
    
    Set xUsedRange = Range(Cells(NewRow1, NewColumn1), Cells(NewRow2, NewColumn2))
End Function
【2010年6月19日土曜日追記】
実はこのコード、"UsedRange"の外側の範囲を与えられたときにうまく動作しないと言う不具合があります。解決法は目下思案中…。

0 件のコメント:

コメントを投稿