Arrays Excel VBA-如何在保留旧数组值的同时向二维变量数组添加行？

我试过了，到处都找过了。我想不出来。 我有一个包含7列的1行表，我正在将值读入数组

然后，我想在代码中的某个点向该数组添加一行，同时保留数组中的旧值。代码如下：

Dim arr作为变型
arr=工作表（工作表）.列表对象（表）.数据源范围

这个“arr”现在是一个2d数组，有1行7列，可以很好地加载数据

稍后在我的代码中，我想向该数组添加一行，因此我尝试以下方法：

ReDim将arr（1到2，1到7）保留为变体

给我一个“下标超出范围”错误

如何向这种类型的数组中添加一行，同时保留其中的其他值

---

谢谢大家。这让我抓狂。

使用ReDim PREVICE时，您只能更改最后一个维度的大小

因此，要执行您想要的操作，请使用

应用程序更改最后一个维度。转置
，重新定尺寸，然后再次转置

Dim arr As Variant

arr = Worksheets(worksheet).ListObjects(table).DataBodyRange

' swap the row/column dimensions
arr = Application.Transpose(arr)

' resize the last, row, dimension
ReDim Preserve arr(1 To 7, 1 To 2)

' swap the row/column dimensions back
arr = Application.Transpose(arr)


通过
Application.Index（）选择
function

为了展示@norie有效解决方案之外的另一种方法，我演示了如何从以下高级重组功能中获益：

注意如果要在添加的行中返回空元素，请插入以下代码行*，覆盖添加的行元素（包含临时错误值）；当然，您也可以在调用过程中输入值*

    'overwrite added row elements with Empty
    If overwrite Then
        Dim rowNum As Long, colNum As Long
        For rowNum = UBound(arr) - nRows + 1 To UBound(arr)
            For colNum = LBound(arr, 2) To UBound(arr, 2)
                arr(rowNum, colNum) = Empty
            Next colNum
        Next rowNum
    End If

将数组追加到数组

appendData
过程将覆盖任意数量的行（和/或列）

选项显式
子附录数据测试（）
Const wsName As String=“Sheet1”
Const tblName As String=“Table1”
将wb设置为工作簿：设置wb=ThisWorkbook包含此代码的工作簿
将ws设置为工作表：设置ws=wb.Worksheets（wsName）
将tbl设置为ListObject：设置tbl=ws.ListObjects（tblName）
Dim数据作为变量：Data=tbl.DataBodyRange.Rows（1）.Value
'添加表的第二个数据行（不包括标题）。
Dim NewData作为变量：NewData=tbl.DataBodyRange.Rows（2）.Value
追加数据
“或者只是：
'追加数据数据，tbl.DataBodyRange.Rows（2）.Value
'将结果写入新工作簿：
'使用工作簿添加工作表（1）
'.Range（“A1”）.Resize（UBound（数据，1），UBound（数据，2））。值=数据
“.Parent.Saved=True”仅用于轻松关闭
"以
端接头
'目的：'将一个（新）数组的值追加到现有数组
“（初始）数组。
'备注：它实际上将两个数组的值写入一个新数组
'并用它“替换”初始数组。
'假定两者都是二维单基阵列。
'结果'数组的行数将相等
'到两个数组的行之和。
'结果'数组的列数将为
'等于初始数组的列数。
'如果新数组的列数更大，
'其余列中的数据将不会追加。
附属资料（_
ByRef数据作为变量_
ByVal（新数据作为变量）
长度为的Dim rCount:rCount=UBound（数据，1）+UBound（新数据，1）
长度为的Dim cCount:cCount=UBound（数据，2）
作为变量的Dim rData:ReDim rData（1到rCount，1到cCount）
变暗r为长，c为长，n为长
对于r=1到uBond（数据，1）
n=n+1
对于c=1的情况，应计算
rData（n，c）=数据（r，c）
下一个c
下一个r
如果UBound（NewData，2）
哇，我从来没有遇到过这种方法-它很简单+1您应该知道，
Application.Transpose
将给出一个错误的结果，如果数组中的行数超过65535行，则不会出现错误消息。@norie fyi发布了另一种方法来完成可能的解决方案集：-）谢谢norie。“转置”。我绝对没有看到这一次。哈哈，我把数组读入字典，每个字典项一行。然后，处理完成后，将阵列调暗并传回<代码>工作表功能。如果保证您的阵列始终具有<
65536
元素，则可以使用转置
，否则您可能很难检测到错误。感谢所有反馈人员！我今天早上刚收到所有这些回复，所以现在才检查。感谢您花这么多时间发布这些我真的很感谢！。最后我选择了“转置”选项。我甚至没有想过这个选择；以前从未使用过转置。天才。
Sub AddRowsToArr(arr, Optional ByVal nRows As Long = 1, Optional overwrite As Boolean = True)
'define arrays of needed row and column numbers
    Dim r, c
    r = Evaluate("row(1:" & CStr(nRows + UBound(arr) - LBound(arr) + 1) & ")")
    c = Application.Transpose(Evaluate("row(1:" & CStr(UBound(arr, 2) - LBound(arr, 2) + 1) & ")"))
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'redimension array to new size
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    arr = Application.Index(arr, r, c)

    '*) optional overwriting added row elements with Empty ~~> see Note below!
    '...
End Sub

    'overwrite added row elements with Empty
    If overwrite Then
        Dim rowNum As Long, colNum As Long
        For rowNum = UBound(arr) - nRows + 1 To UBound(arr)
            For colNum = LBound(arr, 2) To UBound(arr, 2)
                arr(rowNum, colNum) = Empty
            Next colNum
        Next rowNum
    End If