Question

我有一项非常具体的任务，但我做得不太好，想知道是否有人可以帮助我。在我的代码中，我有一个大表，每个月在我的团队中更新，我想要做的是找到标题为“RD”的列标题，然后删除该列中包含值“Ad-Hoc”的所有行（除了从列标题）

Sub Delete_Rows_Based_On_Value()

Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table_owssvr")

    Dim I As Long, finalRow As Long, L As Long
    
For L = tbl.Columns.Count To 1 Step -1
                If Cells(1, L) = "RD" Then
                For I = finalRow To 2 Step -1
                If Range(L, I).Value = "Ad-Hoc" Then
            Range(L, I).EntireRow.Delete
        End If
    Next I
    End If
    Next L

End Sub

想知道是否有人可以帮助我解决这个问题以及我是否走在正确的轨道上。谢谢

Answer 1

你走在正确的轨道上。您需要使用没有列属性的 tbl.ListColumns.Count 列表对象。

您需要为 finalRow 分配一个值，并且您的行和列被交换以寻找“Ad-Hoc”

Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table_owssvr")

Dim I As Long, finalRow As Long, L As Long
    
For L = tbl.ListColumns.Count To 1 Step -1 'tbl.columns will error
    If Cells(1, L) = "RD" Then
        finalRow = Cells(Rows.Count, L).End(xlUp).Row 'Get the last row in column L
        For I = finalRow To 2 Step -1
            If Cells(I, L).Value = "Ad-Hoc" Then 'L is the column it goes second
                Cells(I, L).EntireRow.Delete
            End If
        Next I
    End If
Next L

使用自动过滤器

Sub delete_with_filter()
    Dim tbl As ListObject
    Dim delrange As Range
    Set tbl = ActiveSheet.ListObjects("Table_owssvr")

    With tbl
        .Range.AutoFilter .ListColumns("RD").Index, "Ad-Hoc"
        On Error GoTo errhandler
        Set delrange = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        If Not delrange Is Nothing Then
            Application.DisplayAlerts = False
            delrange.Delete
            Application.DisplayAlerts = True
        End If
        .Range.AutoFilter .ListColumns("RD").Index
        
    End With
errhandler:
    Select Case Err.Number
        Case 1004
            Debug.Print "Exiting Sub, No Cells Found"
            tbl.Range.AutoFilter tbl.ListColumns("RD").Index
            Exit Sub
    End Select

End Sub

Answer 2

删除表中的行

这将删除表格行（不是工作表行）。

代码

Option Explicit

Sub deleteRowsBasedOnValue()
    With ThisWorkbook.Worksheets("Sheet1").ListObjects("Table_owssvr")
        Dim cNum As Long: cNum = .ListColumns("RD").Index
        Dim dRng As Range
        Dim lr As ListRow
        For Each lr In .ListRows
            If lr.Range.Columns(cNum).Value = "Ad-Hoc" Then
                buildRange dRng, lr.Range
            End If
        Next lr
    End With
    If Not dRng Is Nothing Then
        dRng.Delete
    End If
End Sub

Sub buildRange( _
        ByRef BuiltRange As Range, _
        AddRange As Range)
    If BuiltRange Is Nothing Then
        Set BuiltRange = AddRange
    Else
        Set BuiltRange = Union(BuiltRange, AddRange)
    End If
End Sub

Answer 3

很多答案，但我会简短而快速地抛出这个。我进行了测试和工作。

Sub DeleteTableRows()

    Dim tbl As ListObject
    
    Set tbl = ActiveSheet.ListObjects("Table_owssvr")
    
    tbl.Range.AutoFilter Field:=tbl.ListColumns("RD").Index, Criteria1:="Ad-Hoc"
    If tbl.Range.SpecialCells(xlCellTypeVisible).Count > tbl.ListColumns.Count Then
        Application.DisplayAlerts = False
        tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
    End If
     
    tbl.AutoFilter.ShowAllData
    
    
End Sub

根据值删除特定列中的行

3 个答案:

删除表中的行