[英]How to get the range of the visible rows after applying an advanced filter in 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
是否有任何简单的属性可以在应用高级过滤器后为我提供一系列可见的行?
ActiveSheet.Range("A1:A100").Rows.SpecialCells(xlCellTypeVisible)
这会产生一个Range
对象。
Lance 的解决方案适用于大多数情况。
但是如果您处理大型/复杂的电子表格,您可能会遇到“ 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
您可以使用以下代码获取单元格的可见范围:
Excel.Range visibleRange = Excel.Application.ActiveWindow.VisibleRange
希望这可以帮助。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.