excel - 删除表中的所有行而不丢失公式信息vba

Question

我有一张桌子：

这有公式，表中的行数可以变化。我想要一个 VBA 中的代码，我可以将其应用于一个活动按钮，该按钮将删除表的所有行并将其变成如下所示：

但是，我仍然希望在新行中输入的新信息具有与之前存在的旧信息相同的公式。我目前通过选择行并删除它们来手动执行此操作；我什至尝试过创建一个宏，但这不起作用。

任何帮助，将不胜感激 ：）

编辑：这是宏生成的代码：

Sub clear3()
'
' clear3 Macro
'

'
    Range("Table3").Select
    Selection.ListObject.ListRows(1).Delete
    Selection.ListObject.ListRows(1).Delete
    Range("F11").Select
End Sub

--现在，当有两行时，这在表格上可以正常工作，但是当表格有 3 或 1 或任何其他行数时；我明白了：

Runtime Error : '9' Subscript out of range

Answer 1

' copy this into the Worksheet code module
Private Sub CommandButton1_Click()  'ActiveX button's click event handler
    Const TABLE_NAME = "TableN" ' replace with your table name
    Dim lo As ListObject
    
    On Error Resume Next
    Set lo = Me.ListObjects(TABLE_NAME)
    If Err.Number <> 0 Then
        MsgBox TABLE_NAME & " was not found. Check the table name", vbCritical + vbOKOnly, "Sub CommandButton1_Click()"
        Exit Sub
    End If
    On Error GoTo 0
    If Not lo.DataBodyRange Is Nothing Then lo.DataBodyRange.Delete
End Sub

Edit2（多表清理）

' copy this into the Worksheet code module
Private Sub CommandButton1_Click()  'ActiveX button's click event handler
    Dim lo As ListObject, TABLE_NAME
    ' Attention! tables on the same worksheet must not have the same rows/columns,
    ' otherwise you will get an error `Run-time error '1004': This operation is not allowed.
    ' The operation is attempting to shift cells in a table on your worksheet` or something like that.
    For Each TABLE_NAME In Array("Table1", "Table2", "Table3") 'and so on
        On Error Resume Next
        Set lo = Me.ListObjects(TABLE_NAME)
        If Err.Number <> 0 Then
            MsgBox TABLE_NAME & " was not found. Check the table name", vbCritical + vbOKOnly, "Sub CommandButton1_Click()"
            Exit Sub
        End If
        On Error GoTo 0
        If Not lo.DataBodyRange Is Nothing Then lo.DataBodyRange.Delete
    Next
End Sub

Edit3（不同工作表上的表格）

' copy this into the Worksheet code module
Private Sub CommandButton1_Click()  'ActiveX button's click event handler
    Dim lo As ListObject, TABLE_NAME, arr
    For Each TABLE_NAME In Array("Sheet1|Table1", "Sheet2|Table2") 'and so on
        On Error Resume Next
        arr = Split(TABLE_NAME, "|")
        Set lo = Me.Parent.Sheets(arr(0)).ListObjects(arr(1))
        If Err.Number <> 0 Then
            MsgBox TABLE_NAME & " was not found. Check the table name", vbCritical + vbOKOnly, "Sub CommandButton1_Click()"
            Exit Sub
        End If
        On Error GoTo 0
        If Not lo.DataBodyRange Is Nothing Then lo.DataBodyRange.Delete
    Next
End Sub

注意力！同一个工作表上的表不能有相同的行/列，否则你会得到一个错误Run-time error '1004': This operation is not allowed. The operation is attempting to shift cells in a table on your worksheet或类似的东西。

可接受的表格布局示例