使用VBA向表现有范围添加行

Question

当按下按钮时，我正在尝试将所有表的现有范围扩展100行。

我提出了一些简单的代码，但它确实很慢，并且由于某种原因，它没有按照应有的方式填充其中一行。

我是编码的新手，所以我会感激任何建议。编辑：我运行代码后添加了公式的图片。

Sub ExtendRows()
Dim i As Long, j As Long, ws As Worksheet, oListRow As ListRow

Set ws = ActiveWorkbook.Worksheets("Holdbarhed")

Application.ScreenUpdating = False

For i = 1 To 100
    For j = 1 To 10
        Set oListRow = ws.ListObjects(j).ListRows.Add
    Next j
Next i

Application.ScreenUpdating = True
End Sub

公式未正确更新的图片：

Answer 1

速度的问题是每次循环和添加行确实非常慢，并且添加1000行实际上需要大约20秒！

每个与工作表的交互（添加行）都需要时间。但是，无论是一次添加1行还是一次添加100行，都需要几乎相同的时间。因此，在一个命令中添加100行比在一个命令中添加100行要长100倍。

现在存在列表对象表没有一次添加多行的命令的问题。但是，您可以使用解决方法减少交互量：

1. 在每个列表对象表下方一次添加100行（99个不同的添加操作比以前少）。
2. 然后将表调整大小到新空间。

这使我的测试时间减少到0.8秒（每100行添加10个表）。当然，此解决方法仅适用于在列表对象表的末尾添加行。

Public Sub ExtendRowsSpeedyGonzales()
    Const ROWS_TO_ADD As Long = 100  'amount of rows to add each table
    Const TABLE_COUNT As Long = 10   'amount of tables

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Holdbarhed")

    Dim iTable As Long
    For iTable = 1 To TABLE_COUNT
        With ws.ListObjects(iTable)
            Dim OldTableRange As Range
            Set OldTableRange = .Range 'remember original size of table

            'add rows BELOW table
            .Range.Offset(RowOffset:=.Range.Rows.Count).Resize(RowSize:=ROWS_TO_ADD).Insert Shift:=xlDown

            'resize table
            .Resize OldTableRange.Resize(RowSize:=.Range.Rows.Count + ROWS_TO_ADD)
        End With
    Next iTable

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 2

我使用这段代码似乎也复制了公式：

Option Explicit

Sub test()

    Dim tbl  As ListObject, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Set tbl = .ListObjects("tblTest")

            For i = 1 To 3
                tbl.ListRows.Add
            Next i

    End With

End Sub

结果：