使用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分钟。有更快的方法吗?

我尝试过的事情。(请注意:表格中没有其他表格)

1

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

Thanks in advance

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