Добавление строк в существующий диапазон таблиц с помощью 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 строк в одной команде.

Теперь существует проблема, заключающаяся в том, что в таблицах объектов списка нет команды для добавления нескольких строк за один раз ,Но вы можете уменьшить количество взаимодействий, используя обходной путь для этого:

1. Добавить 100 строк сразу , ниже каждой таблицы списка объектов (На 99 отдельных операций добавления меньше, чем раньше) .
2. Затем измените размер таблицы на это новое пространство.

Это сократило время в моем тесте до 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

Результаты: