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没有效果。

然而，第5行以与第3行相同的方式创建，包含行而不是单元格。如果使用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对你有所帮助。这肯定对我有帮助。

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

1 个答案: