将数组粘贴到表格中的某些行和列

Question

我编写了一个函数来将二维数组的内容写入现有表。不会从表中删除任何内容。新行必须添加到底部。列数取决于数组第二维的大小，我假设表有足够的列。

我的问题是：如何在没有以下情况的情况下引用表中的范围： a）将带有表格的表格作为活动表格，并且 b) 无需参考工作表（就像现在在代码中一样；见下文）？

请参阅下面我尝试过的代码。

Function PasteArrayToTable(tblDestinationTable As ListObject, arrSourceArray() As Variant)

'Note: works for arrays starting with index = 1 (option base 1)!

Dim lngNewRows As Long
Dim lngHeaderRowPosition As Long
Dim intHeaderColumnPosition As Long
Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim intFirstColumn As Integer
Dim intLastColumn As Integer
Dim lngNrOfRecordsAtStart As Long

'Number of rows to be added
lngNewRows = UBound(arrSourceArray, 1)

'If the array contains rows, then write them to the destination table
If lngNewRows > 1 Then

    'Get header position of destination table
    lngHeaderRowPosition = tblDestinationTable.HeaderRowRange.Row
    intHeaderColumnPosition = tblDestinationTable.HeaderRowRange.Column

    'Get number of records in table before pasting array, in order to remove afterwards an empty row if the table has 0 rows
    lngNrOfRecordsAtStart = tblDestinationTable.ListRows.Count

    'Add rows to table
    tblDestinationTable.Resize tblDestinationTable.Range.Resize(tblDestinationTable.Range.Rows.Count + lngNewRows)

    'Determine positions where to write array to
    lngFirstRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count + 1 - lngNewRows
    lngLastRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count
    intFirstColumn = intHeaderColumnPosition
    intLastColumn = intFirstColumn - 1 + UBound(arrSourceArray, 2)

    'Write array to determined positions. Note: there's no check whether the table has the required number of columns, nor
    'whether the number of lines fit on the page
    Dim wks As Worksheet
    Set wks = Worksheets("Blad1")
    With wks
        .Range(.Cells(lngFirstRow, intFirstColumn), .Cells(lngLastRow, intLastColumn)).Value = arrSourceArray
    End With

    'Remove empty row if present
    If lngNrOfRecordsAtStart = 0 Then
        tblDestinationTable.ListRows(1).Delete
    End If

End If

End Function

那么如何引用表格中的“单元格”呢？

Answer 1

在解决问题的代码下方。

Function PasteArrayToTable(tblDestinationTable As ListObject, arrSourceArray() As Variant)

'Note: works for arrays starting with index = 1 (option base 1)!

Dim lngHeaderRowPosition As Long
Dim intHeaderColumnPosition As Long
Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim intFirstColumn As Integer
Dim intLastColumn As Integer

'If the array contains rows, then write them to the destination table
If UBound(arrSourceArray, 1) > 1 Then

    'Get header position of destination table
    lngHeaderRowPosition = tblDestinationTable.HeaderRowRange.Row
    intHeaderColumnPosition = tblDestinationTable.HeaderRowRange.Column

    'Determine positions where to write array to
    lngFirstRow = lngHeaderRowPosition + tblDestinationTable.ListRows.Count + 1
    lngLastRow = lngFirstRow + UBound(arrSourceArray, 1) - 1
    intFirstColumn = intHeaderColumnPosition
    intLastColumn = intFirstColumn + UBound(arrSourceArray, 2) - 1

    'Write array contents to the bottom of the destination table
    With tblDestinationTable.Parent
        .Range(.Cells(lngFirstRow, intFirstColumn), .Cells(lngLastRow, intLastColumn)).Value = arrSourceArray
    End With

End If

End Function