如何在Excel (VBA)中应用高级过滤器后获得可见行的范围

Here is the code that applies an advanced filter to the column A on the Sheet1 worksheet (List range) by using the range of values on the Sheet2 (criteria range)

下面是在Sheet1工作表(列表范围)上应用高级过滤器的代码，它使用了Sheet2上的值范围(标准范围)

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

After running this code, I need to do something with the rows that are currently visible on the screen.

运行这段代码之后，我需要对屏幕上当前可见的行做一些操作。

Currently I use a code like this

目前我使用这样的代码

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

Is there any simple property that can give me a range of rows visible after applying an advanced filter?

是否有任何简单的属性可以在应用高级筛选器后给我一系列可见的行?

3 个解决方案

#1

ActiveSheet.Range("A1:A100").Rows.SpecialCells(xlCellTypeVisible)

This yields a Range object.

这将产生一个范围对象。

#2

Lance's solution will work in the majority of situations.

兰斯的解决方案在大多数情况下都有效。

But if you deal with large/complex spreadsheets you might run into the "SpecialCells Problem". In a nutshell, if the range created causes greater than 8192 non-contiguous areas (and it can happen) then Excel will throw an error when you attempt to access SpecialCells and your code won't run. If your worksheets are complex enough you expect to encounter this problem, then it is recommended you stick with the looping approach.

但是，如果您处理的是大型/复杂的电子表格，您可能会遇到“specialcell Problem”。简单地说，如果创建的范围大于8192个非连续区域(并且可能发生)，那么当您尝试访问specialcell时，Excel将抛出一个错误，而您的代码不会运行。如果您的工作表非常复杂，您希望遇到这个问题，那么建议您坚持使用循环方法。

It's worth noting that this problem is not with the SpecialCells property itself, rather it is with the Range object. This means that anytime that you attempt to obtain a range object that could be very complex you should either employee an error handler, or do as you already have done, which is to cause your program to work on each element of the range (split the range up).

值得注意的是，这个问题不是针对SpecialCells属性本身，而是针对Range对象。这意味着，每当您试图获取一个可能非常复杂的范围对象时，您都应该使用一个错误处理程序，或者按照您已经做过的那样做，即使您的程序处理范围的每个元素(将范围分割为多个)。

Another possible approach would be to return an array of Range Objects and then loop through the array. I have posted some example code to play around with. However it should be noted that you really should only bother with this if you expect to have the problem described or you just want to feel assured your code is robust. Otherwise it's just needless complexity.

另一种可能的方法是返回一个范围对象数组，然后在数组中循环。我已经发布了一些示例代码。但是，应该注意的是，如果您希望得到描述的问题，或者您只是希望确信您的代码是健壮的，那么您就应该真正地关注这个问题。否则就是不必要的复杂。

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

#3

You can use the following code to get the visible range of cells:

您可以使用以下代码获取可见的单元格范围:

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

Hope this helps.

希望这个有帮助。