如何应用在Excel（VBA）高级过滤器后，即可获取可见行的范围

Question

下面是通过使用值的范围适用于高级过滤器Sheet1工作表（表范围）在A列码在Sheet2的（标准范围）

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 

代码有没有简单的属性，可以给我一个行范围明显应用了先进的过滤器后？

Answer 1

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

这产生了一个Range对象。

Answer 2

兰斯的解决方案将在大多数情况下工作。

但是，如果你处理大/复杂的电子表格，你可能会遇到的“SpecialCells Problem”。概括地说，如果创建的范围将导致超过8192不连续的区域（它可以发生），那么当您试图访问SpecialCells和你的代码将无法运行Excel将抛出一个错误。如果你的工作表很复杂，你会遇到这个问题，那么建议你坚持使用循环方法。

值得一提的这个问题是不是与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 

Answer 3

您可以使用下面的代码获取细胞的可见范围：

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

希望这有助于。