在過濾范圍內找到最大范圍的可見單元格

Question

我希望能夠找到已過濾表中連續行的最大可見區域。 我知道一種可能的方法是使用“ xlCellTypeVisible”屬性遍歷可見的單元格並計算每個可見區域中的單元格。 但是，數據由數以萬計，有時是成千上萬的行組成，所以我想知道是否有更快，更有效的方法來執行此操作。

Answer 1

幾個月前，我有一個類似的要求，對發現的最佳解決方案不滿意。 盯着你的問題，我突然想到了兩種新技術。 下面的宏演示了兩者。 盡管我無法想象技術2的速度不是更快，但兩者都給出了可接受的結果。

我的宏開始：

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"

我在嘗試過濾器時使用了一些數據。 如果您希望將此宏用作自己實驗的基礎，則必須替換上面的語句。

宏繼續：

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

上面的語句的輸出為：

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

第1行顯示我有5690個數據行。 這比您的要少很多，但是足以充分說明性能。

第2行是以下結果：

Set RngTgt = .Range(.Rows(2), .Rows(RowMax)).SpecialCells(xlCellTypeVisible)
Debug.Print "2  RngTgt " & RngTgt.Address

請注意，范圍地址為$ 2：$ 4，$ 20：$ 22，依此類推。 請注意，該行也被截斷了。 Address屬性提供盡可能多的整個范圍，以使字符串的總長度小於255個字符。

第3行是以下結果：

Debug.Print "3  ";
For Each RngCrnt In RngTgt
  Debug.Print RngCrnt.Address & " ";
  Count = Count + 1
  If Count = 30 Then Exit For
Next
Debug.Print

請注意，盡管范圍地址是針對整行的，但是“ For Each返回單個單元格。 還要注意，盡管我有26列數據，但返回的單元格包括AA2，AB2等。

第4行是以下結果：

Set RngTgt = RngTgt.EntireRow
Debug.Print "4  RngTgt " & RngTgt.Address

看起來，新的Set RngTgt無效。

但是，以與第3行相同的方式創建的第5行包含行而不是單元格。 如果使用Excel 2003，則處理修改后的RngTgt速度將比處理未修改的RngTgt速度快256倍。 如果您使用更高版本的Excel，它將提高16,384。

宏的其余部分通過兩種不同的技術來識別最大范圍。 第一種技術檢查每行的“隱藏”屬性。 第二種技術使用修改后的RngTgt 。 輸出為：

Duration 1: 0.073
Largest range 579 to 582
Duration 2: 0.003
Largest range 579 to 582

我相信持續時間1證明了技術1會給出可接受的結果，但是技術2顯然要快得多。

宏的其余部分是：

    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

我希望技術2對您有所幫助。 這肯定會對我有幫助。