根據值刪除特定列中的行

Question

我有一個非常具體的任務，我不太正確，想知道是否有人可以幫助我。 在我的代碼中，我有一個在我的團隊中每月更新的大表，我想做的是找到名為“RD”的列 header，然后刪除該列中包含值“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