Question

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

我该怎么做？

我在用伪代码思考这样的事情：

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

这可能根本不作为代码有效，但它应该解释我至少在追求什么！

Answer 1

我需要相同的解决方案，但如果您使用本机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

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

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

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

Answer 2

这是你在找什么？

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

它处理两种情况，无论你是否有标题。

Answer 3

杰夫答案的微小变化。

数组中的新数据：

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

水平范围内的新数据：

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

Answer 4

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

Answer 5

这应该对您有帮助。

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

函数或子向表中添加新行和数据

5 个答案: