excel - 使用 VBA 删除表中除标题以外的所有行的更快方法

Question

我有一个查询，我正在尝试删除表中除标题之外的所有行。

这是我正在使用的代码。

Sub Trial 
    Dim ws as Worksheet, tName as ListObject, lastRow as Long
    Set ws = Sheets("Sheet1")
    Set tName = ws.ListObject("Table3")
    
    With tName.Range
                    .Offset(1).SpecialCells(xlCellTypeVisible).Select
                    lastRow = tName.DataBodyRange.Rows.Count
                    
                    For i = lastRow To 2 Step -1
                        Selection.ListObject.ListRows(i).Delete
                    Next i
    End With

     
End Sub

这可行，但删除 4000 行大约需要 6 分钟。有更快的方法吗？？？

我尝试过的事情。（请注意：工作表中没有其他表格）

第一

    ws.Range("A2")
    ws.Range(Selection, Selection.End(xlToRight)).Select
    ws.Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete

没用，报如下错误this won't work because it would move cells in a table

第二个是

   ws.Range("A2").currentRegion.offset(1).select
   Selection.Delete

这也不起作用，抛出以下错误this won't work because it would move cells in a table

提前致谢

标签： excelvba

Answer 1

数据存储在DataBodyRange. 而不是计算该范围内的行并一一删除，只需检查其中是否存在任何内容并将其全部删除。

Public Sub DeleteTableContents()

    Dim lo As ListObject
    Set lo = Sheet1.ListObjects("Table1")
    
    If Not lo.DataBodyRange Is Nothing Then
        lo.DataBodyRange.Delete
    End If

End Sub  

要将数据添加到表中，您可以使用以下代码：

Public Sub PopulateTable()

    Dim lo As ListObject
    Set lo = Sheet1.ListObjects("Table1")
    
    Dim MyNewRow As ListRow
    
    With lo
        'Add a new row to the DataBodyRange and populate by table column number.
        Set MyNewRow = .ListRows.Add
        MyNewRow.Range(1) = "A"
        MyNewRow.Range(2) = "B"
        
        '--OR--
        
        'Populate by table column name.
        MyNewRow.Range(.ListColumns("ColumnName").Index) = "B"
        
    End With

End Sub