Excel ListObject表 – 从ListObject表中删除过滤/隐藏的行

我在敲我的头，find一种方法来从ListObject表中删除过滤/隐藏的行。

过滤不通过代码执行，它由用户使用表头filter执行。 我想删除过滤/隐藏的行之前，列表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方法没有针对xlCellTypeInvisible的特定参数，只有一个针对xlCellTypeVisible 。 要收集所有隐藏的行，我们需要find.DataBodyRange属性和可见行的恭维，而不是相交 。 一个简短的UDF可以照顾到这一点。

一旦隐藏行的联合已经build立，你不能简单地删除行; 你必须循环Range.Areas属性 。 每个区域将包含一个或多个连续的行，这些行可以被删除。

 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 

请记住，在删除行时，从底部开始并朝向顶部工作被认为是“最佳实践”。