如何使用 VBA 根据条件删除 Excel ListObject 中的行?

问题描述 投票:0回答:2

我在 Excel 中有一个名为

tblFruits
的表格,其中包含 10 列,我想删除
Fruit
列包含
Apple
的所有行。我该怎么做?

excel vba
2个回答
13
投票

以下子作品:

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")

3
投票

好吧,似乎 .listrows 属性仅限于一个列表行或所有列表行。

我发现解决这个问题的最简单方法是:

  1. 设置一个包含公式的列,向我指出我想删除的所有行(在这种情况下,您可能不需要公式)

  2. 在该特定列上对列表对象进行排序(最好是这样,以便我要删除的值在排序结束时)

  3. 检索我将删除的列表行范围的地址

  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

希望有帮助...

© www.soinside.com 2019 - 2024. All rights reserved.