所有有關Excel VBA刪除Table錶(ListObject)中的所有數據（或保留第一行公式）的相關代碼集錦 - Excel VBA開髮

Sub DeleteTableRows(ByRef Table As ListObject)
On Error Resume Next
'~~> Clear Header Row `IF` it exists
Table.DataBodyRange.Rows(1).ClearContents
'~~> Delete all the other rows `IF `they exist
Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.Count - 1, _
Table.DataBodyRange.Columns.Count).Rows.Delete
On Error GoTo 0
End Sub

Sub Macro3()
With Sheet1.ListObjects("Table1")
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
End Sub
With Sheet1.ListObjects("Table1") line to this With Range("Table1").ListObject

I have 3 routines which work just fine, just select a cell in a table and run one of the subroutines

Sub ClearTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.DataBodyRange.Rows.ClearContents
End If
End Sub
and Shrink Table to remove the databody range except from the headers and the first data row

Sub ShrinkTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.DataBodyRange.Delete
End If
End Sub
and Delete Table to completely delete the table from the sheet

Sub DeleteTable()
If Not ActiveCell.ListObject Is Nothing Then
ActiveCell.ListObject.Delete
End If
End Sub

Sub Clear_Table()
Range("Table1").Select
Application.DisplayAlerts = False
Selection.Delete
Application.DisplayAlerts = True
Range("A1:G1").Select
Selection.ClearContents
End Sub

Sub DeleteTableRows(ByRef Table As ListObject, KeepFormulas as boolean)

On Error Resume Next

if not KeepFormulas then
Table.DataBodyRange.clearcontents
end if

Table.DataBodyRange.Rows.Delete

On Error GoTo 0

End Sub

Sub DeleteTableRows(ByRef Table as ListObject)

'** Work out the current number of rows in the table
On Error Resume Next ' If there are no rows, then counting them will cause an error
Dim Rows As Integer
Rows = Table.DataBodyRange.Rows.Count ' Cound the number of rows in the table
If Err.Number <> 0 Then ' Check to see if there has been an error
Rows = 0 ' Set rows to 0, as the table is empty
Err.Clear ' Clear the error
End If
On Error GoTo 0 ' Reset the error handling

'** Empty the table *'
With Table
If Rows > 0 Then ' Clear the first row
.DataBodyRange.Rows(1).ClearContents
End If
If Rows > 1 Then ' Delete all the other rows
.DataBodyRange.Offset(1, 0).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
End If
End With

End Sub

Sub DeleteTableRows(ByRef Table As ListObject)

Dim R As Range

On Error Resume Next

Table.DataBodyRange.ClearContents
Set R = Table.Range.Rows(1).Resize(2)
Table.Resize R

On Error GoTo 0

End Sub

Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject

'select ammount of sheets want to this to run
For i = 1 To 3
Sheets(i).Select
Range("A1").Select
Set SelectedCell = ActiveCell
Selection.AutoFilter

'Determine if ActiveCell is inside a Table
On Error GoTo NoTableSelected
TableName = SelectedCell.ListObject.Name
Set ActiveTable = ActiveSheet.ListObjects(TableName)
On Error GoTo 0

'Clear first Row
ActiveTable.DataBodyRange.Rows(1).ClearContents
'Delete all the other rows `IF `they exist
On Error Resume Next
ActiveTable.DataBodyRange.Offset(1, 0).Resize(ActiveTable.DataBodyRange.Rows.Count - 1, _
ActiveTable.DataBodyRange.Columns.Count).Rows.Delete
Selection.AutoFilter
On Error GoTo 0
Next i
Exit Sub
'Error Handling
NoTableSelected:
MsgBox "There is no Table currently selected!", vbCritical

End Sub

聯繫人：	王先生
Email：	18449932@qq.com
QQ：	18449932
微博：	officecn01

聯繫人：

王先生

Email：

18449932@qq.com

QQ：

18449932

微博：

officecn01