将数组粘贴到 table 内的某些行和列

Question

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

我的问题是：如何在没有以下内容的情况下引用 table 中的范围： a) sheet 和 table 作为活动 sheet 和 b) 无需引用作品sheet（就像现在出现在代码中；见下文）？

查看下面我试过的代码。

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

那么如何在table中引用'cells'呢？

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

将数组粘贴到 table 内的某些行和列

Paste array to certain rows and column within table

arrays

excel

vba

listobject