I would like to be able to find the largest visible area of continuous rows in a filtered table. I know one possible way would be to loop through visible cells using the "xlCellTypeVisible" property and count cells in each visible area. However, the data is consisted of tens and sometimes hundreds of thousands of rows so I was wondering if there is a faster, more efficient way to do this.
Some months ago I had a vaguely similar requirement and was unhappy with the best solution I had discovered. Staring at your question, I suddenly thought of two new techniques. The macro below demonstrates both. Both give acceptable results although I cannot imagine a situation in which technique 2 is not the faster.
My macro starts:
Option Explicit
Sub LargestVisibleRange()
Dim Count As Long
Dim NumRowsInLargestRange As Long
Dim RngCrnt As Range
Dim RngTgt As Range
Dim RowCrnt As Long
Dim RowCrntRangeStart As Long
Dim RowLargestRangeEnd As Long
Dim RowLargestRangeStart As Long
Dim RowMax As Long
Dim RowPrev As Long
Dim StartTime As Single
With Worksheets("TrainData")
RowMax = .Cells(Rows.Count, "A").End(xlUp).Row
Debug.Print "1 RowMax " & RowMax
.Cells.AutoFilter
.Range(.Cells(2, 1), .Cells(RowMax, "Z")).AutoFilter Field:=2, Criteria1:=ChrW$(&H2116) & " 9/10"
I have some data I use when I am experimenting with filters. If you wish to use this macro as a basis for your own experiments, you will have to replace the above statements.
The macro continues:
Set RngTgt = .Range(.Rows(2), .Rows(RowMax)).SpecialCells(xlCellTypeVisible)
Debug.Print "2 RngTgt " & RngTgt.Address
Count = 1
Debug.Print "3 ";
For Each RngCrnt In RngTgt
Debug.Print RngCrnt.Address & " ";
Count = Count + 1
If Count = 30 Then Exit For
Next
Debug.Print
Set RngTgt = RngTgt.EntireRow
Debug.Print "4 RngTgt " & RngTgt.Address
Count = 1
Debug.Print "5 ";
For Each RngCrnt In RngTgt
Debug.Print RngCrnt.Address & " ";
Count = Count + 1
If Count = 30 Then Exit For
Next
Debug.Print
The output from the statement above is:
1 RowMax 5691
2 RngTgt $2:$4,$20:$22,$38:$40,$56:$58,$74:$76,$92:$94,$110:$112,$128:$130,$146:$148,$164:$166,$182:$184,$200:$202,$218:$220,$236:$238,$254:$256,$272:$274,$290:$292,$308:$310,$326:$328,$344:$346,$362:$364,$380:$382,$398:$400,$416:$418,$434:$436,$452:$454,$470:$472
3 $A$2 $B$2 $C$2 $D$2 $E$2 $F$2 $G$2 $H$2 $I$2 $J$2 $K$2 $L$2 $M$2 $N$2 $O$2 $P$2 $Q$2 $R$2 $S$2 $T$2 $U$2 $V$2 $W$2 $X$2 $Y$2 $Z$2 $AA$2 $AB$2 $AC$2
4 RngTgt $2:$4,$20:$22,$38:$40,$56:$58,$74:$76,$92:$94,$110:$112,$128:$130,$146:$148,$164:$166,$182:$184,$200:$202,$218:$220,$236:$238,$254:$256,$272:$274,$290:$292,$308:$310,$326:$328,$344:$346,$362:$364,$380:$382,$398:$400,$416:$418,$434:$436,$452:$454,$470:$472
5 $2:$2 $3:$3 $4:$4 $20:$20 $21:$21 $22:$22 $38:$38 $39:$39 $40:$40 $56:$56 $57:$57 $58:$58 $74:$74 $75:$75 $76:$76 $92:$92 $93:$93 $94:$94 $110:$110 $111:$111 $112:$112 $128:$128 $129:$129 $130:$130 $146:$146 $147:$147 $148:$148 $164:$164 $165:$165
Line 1 shows that I have 5690 data rows. This is many less than you have but this is sufficient to give an adequate indication of performance.
Line 2 is the result of:
Set RngTgt = .Range(.Rows(2), .Rows(RowMax)).SpecialCells(xlCellTypeVisible)
Debug.Print "2 RngTgt " & RngTgt.Address
Note that the range addresses are $2:$4, $20:$22 and so on. Note also the line is truncated. The Address property gives as many whole ranges as possible such that the total length of the string is less than 255 characters.
Line 3 is the result of:
Debug.Print "3 ";
For Each RngCrnt In RngTgt
Debug.Print RngCrnt.Address & " ";
Count = Count + 1
If Count = 30 Then Exit For
Next
Debug.Print
Note that although the range addresses were for entire rows, For Each
returns individual cells. Note also that although I have 26 columns of data, the cells returned include AA2, AB2 and so on.
Line 4 is the result of:
Set RngTgt = RngTgt.EntireRow
Debug.Print "4 RngTgt " & RngTgt.Address
It would appear, the new Set RngTgt
has had no effect.
However line 5, which was created in the same way as row 3, contains row instead of cells. If you use Excel 2003, processing the modified RngTgt
will be 256 times faster than processing the unmodified RngTgt
. If you use a later version of Excel, it will be 16,384 faster.
The remainder of the macro identifies the largest range by each of two different techniques. The first technique checks the Hidden property of each row. The second technique uses the modified RngTgt
. The output is:
Duration 1: 0.073
Largest range 579 to 582
Duration 2: 0.003
Largest range 579 to 582
I believe duration 1 demonstrates technique 1 would give acceptable results but technique 2 is obviously substantially faster.
The remainder of the macro is:
StartTime = Timer
RowCrntRangeStart = 0 ' No current visible range
RowLargestRangeStart = 0 ' No range found so far
RowCrnt = 2
Do While True
' Search for visible row
Do While True
If Not .Rows(RowCrnt).Hidden Then
RowCrntRangeStart = RowCrnt
Exit Do
End If
RowCrnt = RowCrnt + 1
If RowCrnt > RowMax Then
Exit Do
End If
Loop
If RowCrntRangeStart = 0 Then
' No unprocessed visible row found
Exit Do
End If
' Search for invisble row
Do While True
If .Rows(RowCrnt).Hidden Then
' Visible range is RowCrntRangeStart to RowCrnt-1
If RowLargestRangeStart = 0 Then
' This is the first visible range
RowLargestRangeStart = RowCrntRangeStart
RowLargestRangeEnd = RowCrnt - 1
NumRowsInLargestRange = RowLargestRangeEnd - RowLargestRangeStart + 1
Else
' Check for new range being larger thsn previous
If RowCrnt - RowCrntRangeStart > NumRowsInLargestRange Then
' This visible range is larger than previous largest
RowLargestRangeStart = RowCrntRangeStart
RowLargestRangeEnd = RowCrnt - 1
NumRowsInLargestRange = RowLargestRangeEnd - RowLargestRangeStart + 1
End If
End If
RowCrntRangeStart = 0 ' Not within visible range
RowCrnt = RowCrnt + 1 ' Step over first row of invisible range
Exit Do
End If
RowCrnt = RowCrnt + 1
If RowCrnt > RowMax Then
Exit Do
End If
Loop
If RowCrnt > RowMax Then
Exit Do
End If
Loop
Debug.Print "Duration 1: " & Format(Timer - StartTime, "##0.####")
Debug.Print "Largest range " & RowLargestRangeStart & " to " & RowLargestRangeEnd
End With
StartTime = Timer
RowCrntRangeStart = 0 ' No current visible range
RowLargestRangeStart = 0 ' No range found so far
For Each RngCrnt In RngTgt
If RowCrntRangeStart = 0 Then
' Start of visible range
RowPrev = RngCrnt.Row
RowCrntRangeStart = RowPrev
Else
' Already within visible range
If RowPrev + 1 = RngCrnt.Row Then
' Within same visible range
RowPrev = RngCrnt.Row
Else
' Have start of new visible range
' Last visible range was RowCrntRangeStart to Rowprev
If RowLargestRangeStart = 0 Then
' This is the first visible range
RowLargestRangeStart = RowCrntRangeStart
RowLargestRangeEnd = RowPrev
NumRowsInLargestRange = RowLargestRangeEnd - RowLargestRangeStart + 1
Else
' Check for new range being larger thsn previous
If RowPrev - RowCrntRangeStart + 1 > NumRowsInLargestRange Then
' This visible range is larger than previous largest
RowLargestRangeStart = RowCrntRangeStart
RowLargestRangeEnd = RowPrev
NumRowsInLargestRange = RowLargestRangeEnd - RowLargestRangeStart + 1
End If
End If
RowCrntRangeStart = RngCrnt.Row ' Start of new visible range
RowPrev = RngCrnt.Row
End If
End If
Next
Debug.Print "Duration 2: " & Format(Timer - StartTime, "##0.####")
Debug.Print "Largest range " & RowLargestRangeStart & " to " & RowLargestRangeEnd
End Sub
I hope technique 2 is helpful for you. It will certainly be helpful for me.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.