2

我正在努力寻找一种从 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
4

1 回答 1

2

不幸的是，Range.SpecialCells 方法没有用于 xlCellTypeInvisible 的特定参数，只有一个用于xlCellTypeVisible的参数。要收集所有隐藏行，我们需要找到.DataBodyRange 属性和可见行的互补，而不是Intersect。一个简短的 UDF 可以解决这个问题。

一旦建立了隐藏行的联合，您就不能简单地删除这些行；您必须循环浏览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

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

于 2016-03-31T16:27:36.107 回答