在过滤范围内找到最大范围的可见单元格

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对您有所帮助。 这肯定会对我有帮助。