添加新行到Excel表（VBA）
我有一个excel，用来logging你为特定的一天和一顿饭摄取的食物。 我有一个网格，其中每一行代表你吃的食物，它有多less糖等。
然后我添加了一个保存button，将所有的数据保存到另一个表中的表格。
这是我所尝试过的
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
我做错了什么？
提前致谢！
你不会说你正在使用哪个版本的Excel。 这是为2007/2010写的（Excel 2003需要一个不同的说法）
你也不会说你是如何调用addDataToTable和你传递给arrData 。
我猜你正在传递一个基于0的数组。 如果是这种情况（表格从A列开始），则iCount将从0开始计数，而.Cells(lLastRow + 1, iCount)将尝试引用无效的列0 。
你也没有利用ListObject 。 您的代码假定ListObject 1位于第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上设置的高级filter引起的。 清除高级筛选器后，.listrows.add再次正常工作。 要清除filter我使用这个 – 不知道如何才能清除filter只为特定的listobject而不是完整的工作表。
Worksheets("mysheet").ShowAllData
我其实只是发现，如果你想添加多行下方selectSelection.ListObject.ListRows.Add AlwaysInsert:=True真的很好。 我只是重复了五次代码，以添加五行到我的表
我以前也有同样的问题，我通过在新表中创build相同的表格，并删除与表格相关联的所有名称范围，我相信当您使用listobjects你不能让你的名字范围包含表希望帮助谢谢
由于使用ListRow.Add可能是一个巨大的瓶颈，如果无法避免，我们应该只使用它。 如果性能对您很重要，请使用此函数来调整表格的大小，这比以推荐的方式添加行更快。
请注意，如果有的话，这将覆盖您桌子下方的数据 ！
这个function是基于Chris Neilsen公认的答案
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
只要删除表格并用不同的名称创build一个新的表格。 也不要删除该表的整个行。 看起来，当整行包含表行被删除时，会损害DataBodyRange的损坏