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

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

Philfri 的答案的微小变化已经是 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 4

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()
    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