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行，在下方每个列表对象表（比以前少了99个不同的添加操作）。
然后将表调整为该新空间。

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

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

结果：

使用VBA将行添加到表现有范围中

2 个答案: