Страницы: 1
RSS
Фильтрация таблицы и удаление отфильтрованых строк, VBA, macro
 
Доброго день,

Есть вот такой код. Что сделать, что бы не удалялись вся таблица. Пример в приложении.
Спасибо.
Код
Sub delete_rule_2()
    Dim xWs As Worksheet
    Dim lo As ListObject
    Dim iCol As Long
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "cover" And xWs.Name <> "mapping" Then
        xWs.Activate

        Set lo = ActiveSheet.ListObjects(1)
        iCol = lo.ListColumns("ABCD").Index
                    
        On Error Resume Next
        lo.AutoFilter.ShowAllData
            With lo.Range
            .AutoFilter Field:=iCol, Criteria1:="X" 'Проблема, тут. Как только этого знаяения нет в колонке, удаляются все строки где его нет. Как поправить?
                If lo Is Nothing Then
                    End
                    Else
                    lo.DataBodyRange.EntireRow.Delete
                    lo.AutoFilter.ShowAllData
                End If
            End With
        End If
    Next xWs
    
End Sub
 
убрать эту строку:
Код
lo.DataBodyRange.EntireRow.Delete
а если надо удалять только то, что отобралось фильтром, то можно использоваться SpecialCells(что-то вроде того):
Код
lo.DataBodyRange.SpecialCells(xlTypeCellVisible).EntireRow.Delete
Хотя, вероятно, правильнее проверять сколько там чего отфильтровалось и отфильтровалось ли. Возможно, перед удалением надо будет поставить обработку ошибок.
Вот так более корректно(писал от руки, с параметром накосячил):
Код
On Error Resume Next
Dim rr As Range
Set rr = lo.DataBodyRange.SpecialCells(xlCellTypeVisible).EntireRow
If Not rr Is Nothing Then
    rr.Delete
End If
On Error GoTo 0
Изменено: Дмитрий(The_Prist) Щербаков - 27.02.2020 18:06:25
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
lo.DataBodyRange.SpecialCells(xlTypeCellVisible).EntireRow.Delete
Спасибо большое, направели.
Вот что получилось. Так работает
Код
Sub delete_rule_1()
    Dim xWs As Worksheet
    Dim lo As ListObject
    Dim iCol As Long
    
    Application.EnableEvents = False
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "cover" And xWs.Name <> "mapping" Then
        xWs.Activate

        Set lo = ActiveSheet.ListObjects(1)
        iCol = lo.ListColumns("Ваше название столбца").Index
                    
        On Error Resume Next
        lo.AutoFilter.ShowAllData
            With lo.Range
            .AutoFilter Field:=iCol, Criteria1:="X" 'или Criteria1:=Array("A", "B", "3","4","5") для нескольких критериев

                If lo Is Nothing Then
                    End
                    Else
                    lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
                    lo.AutoFilter.ShowAllData
                End If
            End With
        End If
    Next xWs
    Application.EnableEvents = True
End Sub
Страницы: 1
Наверх