vba 函数或子添加新行和数据到表

Function or sub to add new row and data to table

提问by Kenny Bones

I want to create a Sub that basically allows me to target an Excel table with a specific name and then insert a new row at the bottom and add data to that row at the same time. Then exit the sub. And if the table only has one row with no data in it, add the data to that row and then exit the sub.

我想创建一个 Sub ，它基本上允许我定位一个具有特定名称的 Excel 表，然后在底部插入一个新行并同时向该行添加数据。然后退出子。如果表只有一行没有数据，则将数据添加到该行，然后退出子。

How can I do this?

我怎样才能做到这一点？

I was thinking something like this, in pseudo code:

我在想这样的事情，用伪代码：

Public Sub addDataToTable(ByVal strTableName as string, ByVal strData as string, ByVal col as integer)

ActiveSheet.Table(strTableName).Select
If strTableName.Rows.Count = 1 Then
    strTableName(row, col).Value = strData
Else
    strTable(lastRow, col).Value = strData
End if

End Sub

This is probably not valid as code at all, but it should explain what I'm after at least!

这可能根本不是有效的代码，但它至少应该解释我所追求的！

回答by Geoff

I needed this same solution, but if you use the native ListObject.Add()method then you avoid the risk of clashing with any data immediately below the table. The below routine checks the last row of the table, and adds the data in there if it's blank; otherwise it adds a new row to the end of the table:

我需要同样的解决方案，但如果您使用本机ListObject.Add()方法，则可以避免与表格下方的任何数据发生冲突的风险。下面的例程检查表的最后一行，如果为空，则在其中添加数据；否则它会在表的末尾添加一个新行：

Sub AddDataRow(tableName As String, values() As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = ActiveWorkbook.Worksheets("Sheet1")
    Set table = sheet.ListObjects.Item(tableName)

    '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
                table.ListRows.Add
                Exit For
            End If
        Next col
    Else
        table.ListRows.Add
    End If

    'Iterate through the last row and populate it with the entries from values()
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(values) + 1 Then lastRow.Cells(1, col) = values(col - 1)
    Next col
End Sub

To call the function, pass the name of the table and an array of values, one value per column. You can get / set the name of the table from the Designtab of the ribbon, in Excel 2013 at least:

要调用该函数，请传递表名和一组值，每列一个值。您可以从Design功能区的选项卡中获取/设置表格的名称，至少在 Excel 2013 中：

Example code for a table with three columns:

包含三列的表的示例代码：

Dim x(2)
x(0) = 1
x(1) = "apple"
x(2) = 2
AddDataRow "Table1", x

回答by JMax

Is this what you are looking for?

这是你想要的？

Option Explicit

Public Sub addDataToTable(ByVal strTableName As String, ByVal strData As String, ByVal col As Integer)
    Dim lLastRow As Long
    Dim iHeader As Integer

    With ActiveSheet.ListObjects(strTableName)
        'find the last row of the list
        lLastRow = ActiveSheet.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
    'add the data a row after the end of the list
    ActiveSheet.Cells(lLastRow + 1 + iHeader, col).Value = strData
End Sub

It handles both cases whether you have header or not.

无论您是否有标题，它都会处理这两种情况。

回答by phillfri

Minor variation on Geoff's answer.

Geoff 的答案略有不同。

New Data in Array:

数组中的新数据：

Sub AddDataRow(tableName As String, NewData As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    '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
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Iterate through the last row and populate it with the entries from values()
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1)
    Next col
End Sub

New Data in Horizontal Range:

水平范围内的新数据：

Sub AddDataRow(tableName As String, NewData As Range)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    'First check if the last table row is empty; if not, add a row
    If table.ListRows.Count > 0 Then
        Set lastRow = table.ListRows(table.ListRows.Count).Range
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Copy NewData to new table record
    Set lastRow = table.ListRows(table.ListRows.Count).Range
    lastRow.Value = NewData.Value
End Sub

回答by rohrl77

Minor variation of phillfri's answer which was already a variation of Geoff's answer: I added the ability to handle completely empty tables that contain no data for the Array Code.

phillfri 答案的细微变化，这已经是 Geoff 答案的变化：我添加了处理完全空表的能力，这些表不包含数组代码的数据。

Sub AddDataRow(tableName As String, NewData As Variant)
    Dim sheet As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim lastRow As Range

    Set sheet = Range(tableName).Parent
    Set table = sheet.ListObjects.Item(tableName)

    '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
        If Application.CountBlank(lastRow) < lastRow.Columns.Count Then
            table.ListRows.Add
        End If
    End If

    'Iterate through the last row and populate it with the entries from values()
    If table.ListRows.Count = 0 Then 'If table is totally empty, set lastRow as first entry
        table.ListRows.Add Position:=1
        Set lastRow = table.ListRows(1).Range
    Else
        Set lastRow = table.ListRows(table.ListRows.Count).Range
    End If
    For col = 1 To lastRow.Columns.Count
        If col <= UBound(NewData) + 1 Then lastRow.Cells(1, col) = NewData(col - 1)
    Next col
End Sub

回答by Sabir Guiri

This should help you.

这应该对你有帮助。

Dim Ws As Worksheet
Set Ws = Sheets("Sheet-Name")
Dim tbl As ListObject
Set tbl = Ws.ListObjects("Table-Name")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

With newrow

        .Range(1, Ws.Range("Table-Name[Table-Column-Name]").Column) = "Your Data"

End With