Блог

Я хотел бы иметь возможность находить наибольшую видимую область непрерывных строк в отфильтрованной таблице. Я знаю, что одним из возможных способов было бы перебирать видимые ячейки, используя свойство «xlCellTypeVisible», и подсчитывать ячейки в каждой видимой области. Однако данные состоят из десятков, а иногда и сотен тысяч строк, поэтому мне было интересно, есть ли более быстрый и эффективный способ сделать это.

Несколько месяцев назад у меня было смутно похожее требование, и я был недоволен лучшим решением, которое я обнаружил. Глядя на ваш вопрос, я внезапно подумал о двух новых методах. Приведенный ниже макрос демонстрирует и то, и другое. Оба дают приемлемые результаты, хотя я не могу представить ситуацию, в которой метод 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 " amp; RowMax

    .Cells.AutoFilter
    .Range(.Cells(2, 1), .Cells(RowMax, "Z")).AutoFilter Field:=2, Criteria1:=ChrW$(amp;H2116) amp; " 9/10"
  

У меня есть некоторые данные, которые я использую, когда экспериментирую с фильтрами. Если вы хотите использовать этот макрос в качестве основы для своих собственных экспериментов, вам придется заменить приведенные выше инструкции.

Макрос продолжается:

 Set RngTgt = .Range(.Rows(2), .Rows(RowMax)).SpecialCells(xlCellTypeVisible)
Debug.Print "2  RngTgt " amp; RngTgt.Address
Count = 1
Debug.Print "3  ";
For Each RngCrnt In RngTgt
  Debug.Print RngCrnt.Address amp; " ";
  Count = Count   1
  If Count = 30 Then Exit For
Next
Debug.Print

Set RngTgt = RngTgt.EntireRow
Debug.Print "4  RngTgt " amp; RngTgt.Address

Count = 1
Debug.Print "5  ";
For Each RngCrnt In RngTgt
  Debug.Print RngCrnt.Address amp; " ";
  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 " amp; RngTgt.Address
  

Обратите внимание, что адреса диапазона являются $2:$4, $20:$22 и так далее. Обратите также внимание, что строка усечена. Свойство Address предоставляет как можно больше целых диапазонов, чтобы общая длина строки составляла менее 255 символов.

Строка 3 является результатом:

 Debug.Print "3  ";
For Each RngCrnt In RngTgt
  Debug.Print RngCrnt.Address amp; " ";
  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 " amp; RngTgt.Address
  

Казалось бы, новое Set RngTgt не оказало никакого эффекта.

Однако строка 5, которая была создана тем же способом, что и строка 3, содержит строку вместо ячеек. Если вы используете Excel 2003, обработка измененных RngTgt данных будет в 256 раз быстрее, чем обработка неизмененных RngTgt . Если вы используете более позднюю версию 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: " amp; Format(Timer - StartTime, "##0.####")
    Debug.Print "Largest range " amp; RowLargestRangeStart amp; " to " amp; 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: " amp; Format(Timer - StartTime, "##0.####")
  Debug.Print "Largest range " amp; RowLargestRangeStart amp; " to " amp; RowLargestRangeEnd

End Sub
  

Я надеюсь, что метод 2 полезен для вас. Это, безусловно, будет полезно для меня.