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

Я бью головой, чтобы найти способ удалить отфильтрованные / скрытые строки из таблицы 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

excel vba excel-tables listobject
person Gilles F    schedule 31.03.2016    source источник

Ответы (1)


arrow_upward
2
arrow_downward

К сожалению, у метода 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

Помните, что при удалении строк считается «лучшей практикой» начинать снизу и двигаться вверх.

person Community    schedule 31.03.2016
comment
Большое спасибо Jeeped, он работает отлично, и объяснение очень четкое! - person Gilles F; 05.04.2016