Прокрутите список отфильтрованных и выделите 20 процентов от общего числа видимых строк

Question

У меня есть список, который был автоматически отфильтрован.

Моя цель - выделить 20 процентов от общего видимого ряда.

У меня уже есть код, однако я не уверен, как приступить к выделению 20 процентов, начиная с первой видимой строки.

Код ниже выделяет все видимые строки:

Sub HighlightTwentyPercent()

Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim rng As Range
Set sht = Worksheets("Input raw")
Set StartCell = Range("F2")
Dim cl As Range


LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

Set rng = sht.Range(StartCell, sht.Cells(LastRow, 6))

For Each cl In rng.SpecialCells(xlCellTypeVisible)

    cl.Interior.Color = RGB(255, 12, 29)

Next cl

End Sub

Пример:

Если общая видимая строка равна 50, тогда она будет выделена на 20 процентов. В этом случае будет выделено 10 строк из первой видимой строки.

Answer 1

Это можно сделать без VBA, используя следующее правило условного формата (при условии, что ваши данные на F2:F51 для вашего примера):

=SUBTOTAL(3,$F$2:$F2)<=SUBTOTAL(3,$F$2:$F$51)/5

Возможно, вам потребуется настроить его в зависимости от того, как вы хотите обрабатывать округленные значения (например, если вы хотите выделить 2 видимых ряда из 9).

Answer 2

Следующий код вычислит количество строк, равное 20% видимых строк, а затем выйдет из цикла For, как только это число будет достигнуто:

Sub HighlightTwentyPercent()

Dim sht As Worksheet: Set sht = Worksheets("Input raw")
Dim LastRow As Long, LastColumn As Long
Dim StartCell As Range, rng As Range
Dim cl As Range
Dim TwentyPc As Long, i As Long
Set StartCell = Range("F2")

LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

Set rng = sht.Range(StartCell, sht.Cells(LastRow, 6))
TwentyPc = Round(rng.Rows.SpecialCells(xlCellTypeVisible).Count * 0.2, 0)

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    i = i + 1
    If i > TwentyPc Then Exit For
    cl.Interior.Color = RGB(255, 12, 29)
Next cl
End Sub