Добавить новую строку в таблицу excel (VBA)

у меня есть excel, который служит для записи пищи, которую вы глотаете в течение определенного дня и еды. У меня есть сетка, в которой каждая строка представляет пищу, которую вы ели, сколько сахара у нее есть и т. д.

затем я добавил кнопку СОХРАНИТЬ, чтобы сохранить все данные в таблицу на другом листе.

это то, что я пробовал

    Public Sub addDataToTable(ByVal strTableName As String, ByRef arrData As Variant)
    Dim lLastRow As Long
    Dim iHeader As Integer
    Dim iCount As Integer

    With Worksheets(4).ListObjects(strTableName)
        'find the last row of the list
        lLastRow = Worksheets(4).ListObjects(strTableName).ListRows.Count

        'shift from an extra row if list has header
        If .Sort.Header = xlYes Then
            iHeader = 1
        Else
            iHeader = 0
        End If
    End With

    'Cycle the array to add each value
    For iCount = LBound(arrData) To UBound(arrData)
        **Worksheets(4).Cells(lLastRow + 1, iCount).Value = arrData(iCount)**
    Next iCount
End Sub

но я продолжаю получать ту же ошибку в выделенной строке:

Application-defined or object-defined error

что я делаю неправильно?

спасибо вперед!

8 ответов


вы не говорите, какую версию Excel вы используете. Это написано для 2007/2010 (другой apprach требуется для Excel 2003)

вы также не говорите, как вы звоните addDataToTable и что вы переходите в arrData.
Я предполагаю, что вы проходите 0 массив. Если это так (и таблица начинается в столбце A), то iCount будет отсчитываться от 0 и .Cells(lLastRow + 1, iCount) попытается сослаться на столбец 0 что недействительный.

вы также не пользуетесь ListObject. Ваш код предполагает ListObject1 находится, начиная со строки 1. Если это не так, ваш код поместит данные в неправильную строку.

вот альтернатива, которая использовала ListObject

Sub MyAdd(ByVal strTableName As String, ByRef arrData As Variant)
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    ' Based on OP 
    ' Set Tbl = Worksheets(4).ListObjects(strTableName)
    ' Or better, get list on any sheet in workbook
    Set Tbl = Range(strTableName).ListObject
    Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)

    ' Handle Arrays and Ranges
    If TypeName(arrData) = "Range" Then
        NewRow.Range = arrData.Value
    Else
        NewRow.Range = arrData
    End If
End Sub

можно назвать по-разному:

Sub zx()
    ' Pass a variant array copied from a range
    MyAdd "MyTable", [G1:J1].Value
    ' Pass a range
    MyAdd "MyTable", [G1:J1]
    ' Pass an array
    MyAdd "MyTable", Array(1, 2, 3, 4)
End Sub

Tbl.ListRows.Add не работает для меня, и я считаю, что многие другие сталкиваются с той же проблемой. Я использую следующий обходной путь:

    'First check if the last row is empty; if not, add a row
    If table.ListRows.count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.count).Range
        For col = 1 To lastRow.Columns.count
            If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then
                lastRow.Cells(1, col).EntireRow.Insert
                'Cut last row and paste to second last
                lastRow.Cut Destination:=table.ListRows(table.ListRows.count - 1).Range
                Exit For
            End If
        Next col
    End If

    'Populate last row with the form data
    Set lastRow = table.ListRows(table.ListRows.count).Range
    Range("E7:E10").Copy
    lastRow.PasteSpecial Transpose:=True
    Range("E7").Select
    Application.CutCopyMode = False

надеюсь, это поможет кому-то там.


У меня было такое же сообщение об ошибке, и после множества проб и ошибок выяснилось, что это было вызвано расширенным фильтром, который был установлен на ListObject. После очистки расширенного фильтра .listrows.добавить снова работал нормально. Чтобы очистить фильтр, я использую это - не знаю, как можно очистить фильтр только для конкретного listobject вместо полного листа.

Worksheets("mysheet").ShowAllData

Я на самом деле только что обнаружил, что если вы хотите добавить несколько строк ниже выбора в таблице Selection.ListObject.ListRows.Add AlwaysInsert:=True работает очень хорошо. Я просто дублировал код пять раз, чтобы добавить пять строк в мою таблицу


У меня была та же проблема раньше, и я исправил ее, создав ту же таблицу на новом листе и удалив все диапазоны имен, связанные с таблицей, я считаю, что когда вы используете listobjects, вы не alowed, чтобы иметь диапазоны имен, содержащиеся в вашей таблице, надеюсь, что это поможет спасибо


столкнулся с этой проблемой сегодня (Excel аварийно завершает работу при добавлении строк с помощью .ListRows.Add). Прочитав этот пост и проверив свою таблицу, я понял, что вычисления формулы в некоторых ячейках строки зависят от значения в других ячейках. В моем случае клетки в более высоком столбце и даже клетки с формулой!

решение состояло в том, чтобы заполнить новую добавленную строку сзади спереди, чтобы вычисления не ошиблись.

Excel нормально может общаться с формулой в различном ячейки, но, похоже, добавление строки в таблицу вызывает пересчет в порядке столбцов (A,B,C и т. д..).

надеюсь, это поможет устранить проблемы с .ListRows.Add


просто удалите таблицу и создайте новую таблицу с другим именем. Также не удаляйте всю строку для этой таблицы. Кажется, когда вся строка, содержащая строку таблицы, удаляется, она повреждает DataBodyRange поврежден


Как использовать ListRow.Add может быть огромная шея бутылки, мы должны только использовать ее если ее нельзя избежать. Если производительность важна для вас, используйте эту функцию здесь, чтобы изменить размер таблицы, что намного быстрее, чем добавление строк рекомендуемым способом.

имейте в виду, что это будет перезаписи данных под вашей таблицей, если есть!

эта функция основана на принятом ответе Крису Нильсену

Public Sub AddRowToTable(ByRef tableName As String, ByRef data As Variant)
    Dim tableLO As ListObject
    Dim tableRange As Range
    Dim newRow As Range

    Set tableLO = Range(tableName).ListObject
    tableLO.AutoFilter.ShowAllData

    If (tableLO.ListRows.Count = 0) Then
        Set newRow = tableLO.ListRows.Add(AlwaysInsert:=True).Range
    Else
        Set tableRange = tableLO.Range
        tableLO.Resize tableRange.Resize(tableRange.Rows.Count + 1, tableRange.Columns.Count)
        Set newRow = tableLO.ListRows(tableLO.ListRows.Count).Range
    End If

    If TypeName(data) = "Range" Then
        newRow = data.Value
    Else
        newRow = data
    End If
End Sub