Excel ListObject Table - Remove filtered / hidden

2019-07-17 18:23发布

I am banging my head to find a way to delete filtered/hidden rows from a ListObject table.

The filtering is not performed trough the code, it's performed by the user using the table header filters. I want to remove the filtered/hidden rows before unlisting the ListObject Table and perform Subtotal operation. If I don't delete the filtered/hidden rows before unlisting the Table, these rows reappear.

Current Code :

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

1条回答
Lonely孤独者°
2楼-- · 2019-07-17 18:46

Unfortunately, the Range.SpecialCells method does not have a specific parameter for xlCellTypeInvisible, only one for xlCellTypeVisible. To collect all of the hidden rows we need to find the compliment of the .DataBodyRange property and the visible rows, not the Intersect. A short UDF can take care of that.

Once a Union of the hidden rows have been established you cannot simply delete the rows; you must cycle through the Range.Areas property. Each area will contain one or more contiguous rows and those can be deleted.

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

Remember that it is considered 'best practise' to start at the bottom and work towards the top when deleting rows.

查看更多
登录 后发表回答