Как удалить строки в Excel ListObject на основе критериев с помощью VBA?

у меня есть таблица в Excel называется tblFruits с 10 столбцами и я хочу удалить все строки, где

6
excel excel-vba vba

2 ответов

работает следующий sub:

Private Sub deleteTableRowsBasedOnCriteria(tbl As ListObject, columnName As String, criteria As String)

    Dim x As Long, lastrow As Long, lr As ListRow
    lastrow = tbl.ListRows.Count
    For x = lastrow To 1 Step -1
        Set lr = tbl.ListRows(x)
        If Intersect(lr.Range, tbl.ListColumns(columnName).Range).Value = criteria Then
            'lr.Range.Select
            lr.Delete
        End If
    Next x

End Sub

sub может быть выполнен следующим образом:

Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("tblFruits")
Call deleteTableRowsBasedOnCriteria(tbl, "Fruit", "Apple")
8

Ну, похоже .свойство listrows ограничено одной строкой списка или всеми строками списка.

самый простой способ я нашел, чтобы обойти это:

  1. настройка столбца с формулой, которая указала бы мне все строки, которые я хотел бы исключить (в этом случае вам может не понадобиться формула)

  2. сортировка listobject по этому конкретному столбцу (желательно, чтобы мое значение было удалено в конце сортировка)

  3. получение адреса диапазона listrows я удалю

  4. наконец, удаление полученного диапазона, перемещение ячеек вверх.

в этом конкретном фрагменте кода:

Sub Delete_LO_Rows
    Const ctRemove as string = "Remove" 'value to be removed
    Dim myLO as listobject, r as long
    Dim N as integer 'number of the listcolumn with the formula

    Set myLo = Sheet1.ListObjects("Table1") 'listobject goes here

    With myLO
        With .Sort
            With .SortFields
                .Clear
                .Add Key:=.HeaderRowRange(myLO.ListColumns(N)), SortOn:= _
                xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End With        
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        On Error GoTo NoRemoveFound
        r = Application.WorksheetFunction.Match(ctRemove, .ListColumns(.ListColumns.Count).DataBodyRange, 0)
        Range(.parent.name & "!" & .DataBodyRange(r, 1).Address & ":" & .DataBodyRange(.ListRows.Count, .ListColumns.Count).Address).Delete xlShiftUp
'Added the .parent.name to make sure the address is on the correct sure, but it will fail if there are any spaces or characters on the sheet name that will make it need a pair of '.
'The error is just to skip these two lines in case the match returns an error. There's likely a better/cleaner way to do that.
NoRemoveFound:
    End With
End sub

надеюсь, что это помогает...

3