如何應用在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 

希望這有助於。