如何根據使用VBA的條件刪除Excel ListObject中的行？

Question

我在Excel中有一個名為tblFruits的表，有10列，我想刪除Fruit列包含Apple所有行。 我怎樣才能做到這一點？

Answer 1

以下子工作：

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

子可以像這樣執行：

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

Answer 2

好吧，似乎.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

希望能幫助到你...