Таблица Excel ListObject - удалить отфильтрованные/скрытые строки из таблицы ListObject

Question

Я ударяю головой, чтобы найти способ удаления фильтрованных/скрытых строк из таблицы ListObject.

Фильтрация не выполняется через код, она выполняется пользователем с использованием фильтров заголовков таблиц. Я хочу удалить отфильтрованные/скрытые строки перед тем, как заблокировать таблицу ListObject и выполнить операцию «Итого». Если я не удаляю отфильтрованные/скрытые строки перед тем, как отменить таблицу, эти строки снова появятся.

Текущий код:

Sub SubTotalParClassification(ReportSheetTitle) 
Dim ws As Worksheet 
Dim drng As Range 

Endcol = ColCalculationEndIndex 
Set ws = Sheets(ReportSheetTitle) 

'CODE TO REMOVE HIDDEN/FILTERED ROWS 
Set lo = ActiveSheet.ListObjects("Entrée") 
For i = 1 To lo.ListRows.Count Step 1 
    If Rows(lo.ListRows(i).Range.Row).Hidden = True Then 
     lo.ListRows(i).Delete 
Next 

' convert the table back to a range to be able to build subtotal 
ws.ListObjects("Entrée").Unlist 
With ws 
    'Select range to Subtotal 
    Set drng = .Range(.Cells(REPORTHEADERROW, REPORTSSTARTCOL),  .Cells(EndRow, Endcol)) 

    'apply Excel SubTotal function 
    .Cells.RemoveSubtotal 
    drng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(Endcol - 6, Endcol - 5, Endcol - 4, Endcol - 3, Endcol - 2, Endcol - 1) 
    End With 

'Update EndRow 
EndRow = ActiveSheet.Cells(Rows.Count, REPORTSSTARTCOL).End(xlUp).Row 
End Sub 

Answer 1

К сожалению, Range.SpecialCells method не имеет конкретный параметр для xlCellTypeInvisible, только один для xlCellTypeVisible. Чтобы собрать все скрытые строки, нам нужно найти комплимент .DataBodyRange property и видимых строк, а не Intersect. Короткий UDF может позаботиться об этом.

После того, как были установлены Union скрытых строк, вы не можете просто удалить строки; вы должны пройти через Range.Areas property. Каждая область будет содержать одну или несколько смежных строк, и они могут быть удалены.

Option Explicit 

Sub wqewret() 
    SubTotalParClassification "Sheet3" 
End Sub 

Sub SubTotalParClassification(ReportSheetTitle) 
    Dim a As Long, delrng As Range 
    With Worksheets(ReportSheetTitle) 
     With .ListObjects("Entrée") 
      'get the compliment of databody range and visible cells 
      Set delrng = complimentRange(.DataBodyRange, .DataBodyRange.SpecialCells(xlCellTypeVisible)) 
      Debug.Print delrng.Address(0, 0) 
      'got the invisible cells, loop through the areas backwards to delete 
      For a = delrng.Areas.Count To 1 Step -1 
       delrng.Areas(a).EntireRow.Delete 
      Next a 
     End With 
    End With 
End Sub 

Function complimentRange(bdyrng As Range, visrng As Range) 
    Dim rng As Range, invisrng As Range 

    For Each rng In bdyrng.Columns(1).Cells 
     If Intersect(visrng, rng) Is Nothing Then 
      If invisrng Is Nothing Then 
       Set invisrng = rng 
      Else 
       Set invisrng = Union(invisrng, rng) 
      End If 
     End If 
    Next rng 
    Set complimentRange = invisrng 
End Function 

Помните, что это считается «лучшей практикой», начинающейся снизу и работающей в направлении вершины при удалении строк.