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

是否有任何简单的属性,可以给我一个范围的行后,应用先进的filter可见?

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

这产生一个Range对象。

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

但是,如果您处理大型/复杂的电子表格,则可能会遇到“ 特殊问题 ” 问题 。 简而言之,如果创build的范围导致大于8192个非连续区域(并且可能发生),那么当您尝试访问SpecialCell时,Excel将引发错误,您的代码将无法运行。 如果你的工作表很复杂,你会遇到这个问题,那么build议你坚持循环的方法。

值得注意的是,这个问题不是用SpecialCells属性本身,而是用Range对象。 这意味着,无论何时您试图获得一个可能非常复杂的范围对象,您都应该雇佣一个error handling程序,或者按照您已经完成的操作,这将导致您的程序在该范围的每个元素上工作(分割范围内)。

另一种可能的方法是返回一个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 

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

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

希望这可以帮助。