web-dev-qa-db-ja.com

Excel（VBA）で高度なフィルターを適用した後に表示される行の範囲を取得する方法

Sheet2の値の範囲（基準範囲）を使用してSheet1ワークシート（リストの範囲）の列Aに高度なフィルターを適用するコードは次のとおりです

Range("A1:A100").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Sheet2").Range("A1:A10"), Unique:=False

このコードを実行した後、現在画面に表示されている行を使用して何かを行う必要があります。

現在、私はこのようなコードを使用しています

For i = 1 to maxRow
   If Not ActiveSheet.Row(i).Hidden then
     ...do something that I need to do with that rows
   EndIf
Next

高度なフィルターを適用した後、行の範囲を表示できる単純なプロパティはありますか？

excelvbaexcel-vba
11
Bogdan_Ch
ActiveSheet.Range("A1:A100").Rows.SpecialCells(xlCellTypeVisible)

これにより、Rangeオブジェクトが生成されます。

19
Lance Roberts

Lanceのソリューションは、ほとんどの状況で機能します。

しかし、大規模で複雑なスプレッドシートを扱うと、「 SpecialCells Problem 」に遭遇する可能性があります。一言で言えば、作成された範囲が8192を超える非隣接領域を引き起こす（そしてそれができる場合）と、Excelはエラーをスローします。 SpecialCellsにアクセスすると、コードは実行されません。ワークシートが複雑でこの問題が発生すると予想される場合は、ループアプローチを使用することをお勧めします。

この問題はSpecialCellsプロパティ自体にあるのではなく、Rangeオブジェクトにあることに注意してください。これは、非常に複雑になる可能性のある範囲オブジェクトを取得しようとするときはいつでも、エラーハンドラを使用するか、すでに行ったように実行する必要があることを意味します。これにより、プログラムは範囲の各要素で動作します（分割レンジアップ）。

別の可能なアプローチは、範囲オブジェクトの配列を返し、その配列をループすることです。いくつかのサンプルコードを試してみました。ただし、問題が説明されていると予想される場合、またはコードが堅牢であることを確認したい場合にのみ、これを気にする必要があることに注意してください。そうでなければ、それは単に不必要な複雑さです。


Option Explicit

Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub GenerateProblem()
    'Run this to set up an example spreadsheet:
    Dim row As Long
    Excel.Application.EnableEvents = False
    Sheet1.AutoFilterMode = False
    Sheet1.UsedRange.Delete
    For row = 1 To (8192& * 4&) + 1&
        If row Mod 3& Then If Int(10& * Rnd)  7& Then Sheet1.Cells(row, 1&).value = "test"
    Next
    Sheet1.UsedRange.AutoFilter 1&, ""
    Excel.Application.EnableEvents = True
    MsgBox Sheet1.UsedRange.SpecialCells(xlCellTypeVisible).address
End Sub

Public Sub FixProblem()
    'Run this to see various solutions:
    Dim ranges() As Excel.Range
    Dim index As Long
    Dim address As String
    Dim startTime As Long
    Dim endTime As Long
    'Get range array.
    ranges = GetVisibleRows
    'Do something with individual range objects.
    For index = LBound(ranges) To UBound(ranges)
        ranges(index).Interior.ColorIndex = Int(56 * Rnd + 1)
    Next

    'Get total address if you want it:
    startTime = GetTickCount
    address = RangeArrayAddress(ranges)
    endTime = GetTickCount
    Debug.Print endTime - startTime, ; 'Outputs time elapsed in milliseconds.

    'Small demo of why I used a string builder. Straight concatenation is about
    '10 times slower:
    startTime = GetTickCount
    address = RangeArrayAddress2(ranges)
    endTime = GetTickCount
    Debug.Print endTime - startTime
End Sub

Public Function GetVisibleRows(Optional ByVal ws As Excel.Worksheet) As Excel.Range()
    Const increment As Long = 1000&
    Dim max As Long
    Dim row As Long
    Dim returnVal() As Excel.Range
    Dim startRow As Long
    Dim index As Long
    If ws Is Nothing Then Set ws = Excel.ActiveSheet
    max = increment
    ReDim returnVal(max) As Excel.Range
    For row = ws.UsedRange.row To ws.UsedRange.Rows.Count
        If Sheet1.Rows(row).Hidden Then
            If startRow  0& Then
                Set returnVal(index) = ws.Rows(startRow & ":" & (row - 1&))
                index = index + 1&
                If index > max Then
                    'Redimming in large increments is an optimization trick.
                    max = max + increment
                    ReDim Preserve returnVal(max) As Excel.Range
                End If
                startRow = 0&
            End If
        ElseIf startRow = 0& Then startRow = row
        End If
    Next
    ReDim Preserve returnVal(index - 1&) As Excel.Range
    GetVisibleRows = returnVal
End Function

Public Function RangeArrayAddress(ByRef value() As Excel.Range, Optional lowerindexRV As Variant, Optional upperindexRV As Variant) As String
    'Parameters left as variants to allow for "IsMissing" values.
    'Code uses bytearray string building methods to run faster.
    Const incrementChars As Long = 1000&
    Const unicodeWidth As Long = 2&
    Const comma As Long = 44&
    Dim increment As Long
    Dim max As Long
    Dim index As Long
    Dim returnVal() As Byte
    Dim address() As Byte
    Dim indexRV As Long
    Dim char As Long
    increment = incrementChars * unicodeWidth 'Double for unicode.
    max = increment - 1& 'Offset for array.
    ReDim returnVal(max) As Byte
    If IsMissing(lowerindexRV) Then lowerindexRV = LBound(value)
    If IsMissing(upperindexRV) Then upperindexRV = UBound(value)
    For index = lowerindexRV To upperindexRV
        address = value(index).address
        For char = 0& To UBound(address) Step unicodeWidth
            returnVal(indexRV) = address(char)
            indexRV = indexRV + unicodeWidth
            If indexRV > max Then
                max = max + increment
                ReDim Preserve returnVal(max) As Byte
            End If
        Next
        returnVal(indexRV) = comma
        indexRV = indexRV + unicodeWidth
        If indexRV > max Then
            max = max + increment
            ReDim Preserve returnVal(max) As Byte
        End If
    Next
    ReDim Preserve returnVal(indexRV - 1&) As Byte
    RangeArrayAddress = returnVal
End Function

Public Function RangeArrayAddress2(ByRef value() As Excel.Range, Optional lowerIndex As Variant, Optional upperIndex As Variant) As String
    'Parameters left as variants to allow for "IsMissing" values.
    'Code uses bytearray string building methods to run faster.
    Const incrementChars As Long = 1000&
    Const unicodeWidth As Long = 2&
    Dim increment As Long
    Dim max As Long
    Dim returnVal As String
    Dim index As Long
    increment = incrementChars * unicodeWidth 'Double for unicode.
    max = increment - 1& 'Offset for array.
    If IsMissing(lowerIndex) Then lowerIndex = LBound(value)
    If IsMissing(upperIndex) Then upperIndex = UBound(value)
    For index = lowerIndex To upperIndex
        returnVal = returnVal & (value(index).address & ",")
    Next
    RangeArrayAddress2 = returnVal
End Function
20
Oorang

次のコードを使用して、セルの表示範囲を取得できます。

Excel.Range visibleRange = Excel.Application.ActiveWindow.VisibleRange

お役に立てれば。

0
Eshwar