|
Lance's solution will work in the majority of situations. But if you deal with large/complex spreadsheets you might run into the "". 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. 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). 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 (责任编辑：) |