Excel VBA 将新行插入数组

Question

我有一个二维数组，我想在数组中间的某个行号处插入一些行。

数组已经有现有信息，所以如果我想简单地将新信息放在中间，那么 ReDim Preserve 就不能很好地工作。

有什么想法吗？

Answer 1

假设有两个 1-based 2-dim 数据字段输入，我演示了 @FaneDuru 的有效方法的替代方法，使用单独的 combo list 创建作为 数据容器 并允许通过现在可分配的.AddItem 方法进行简单的项目插入。

请注意，这种方法当然可以在许多方面进行改进，例如通过允许输入数组使用不同的索引基数。 - 有条不紊的提示： 分配从零开始的组合的.Column 属性（即倒置的.List 属性）并将其转回允许此处重新获得输入数组的原始从一开始的索引作为ReDim Preserve 会失败（它只能重新调整最后一个维度）。

Sub AddElement(datafield, ByVal rowNum As Long, newData)
'Note: assumes 1-based 2dim input arrays with same column counts
'create zero-based combo container on the fly
With CreateObject("Forms.ComboBox.1")
    .list = datafield     ' assign datafield to zero-based list elems
    .AddItem , rowNum - 1 ' add Null values to zero-based list index
    'assign new data to each zero-based list column
        Dim col As Long
        For col = LBound(newData, 2) To UBound(newData, 2)
            .list(rowNum - 1, col - 1) = newData(1, col)
        Next col
    'overwrite original datafield with transposed list values to regain 1-based elems
    datafield = Application.Transpose(.Column)    ' overwriting data (with zerobased dimensions)
End With

End Sub

由于 datafield 参数通过引用 (ByRef) 隐式传递，原始数据输入将被覆盖。

插入新的第二行的示例调用

Dim data:    data = Sheet1.Range("A1:C4").Value
Dim newData: newData = Sheet2.Range("A1:C1").Value
AddElement data, 2, newData

Answer 2

重播@T.M.不错的方法：

尝试使用不需要转置列数组的下一个函数：

Function AddElement(datafield, ByVal rowNum As Long, newData) As Variant
    'Note: assumes 1-based 2dim input arrays with same column counts
    'create zero-based combo container on the fly
    With CreateObject("Forms.ComboBox.1")
        .list = datafield     ' assign datafield to zero-based list elems
        .AddItem , rowNum - 1 ' add Null values to zero-based list index
        'assign new data to each zero-based list column
            Dim col As Long
            For col = LBound(newData, 2) To UBound(newData, 2)
                .list(rowNum - 1, col - 1) = newData(1, col)
            Next col
        AddElement = .list 'it returns a zero based 2D array...
    End With
End Function

可以这样测试：

Sub testAddArrayrow()
 Dim sh As Worksheet, newArr: sh = ActiveSheet  'was easier for me to check...
 Dim data:    data = sh.Range("A1:C4").Value
 Dim newData: newData = sh.Range("A6:C6").Value
    newArr = AddElement(data, 2, newData)
    sh.Range("P1").Resize(UBound(newArr) + 1, UBound(newArr, 2) + 1).Value = newArr '+ 1 because of zero bazed 2D returned array
End Sub

我们必须进行一些研究以检查数组大小限制（如果有）。没有这样的限制会很有趣，但我不能对这个方向抱太大希望...... :)

无论如何，这个绝妙的想法仍然存在......

Answer 3

请尝试下一个方法：

Sub TestInsertRow()
    Dim sh, arr, arrInsR, arrFin
    
    Set sh = ActiveSheet
    arr = sh.[A1:C5].Value       'array to insert a row
    arrInsR = sh.[A11:C11].Value 'row to be inserted
    arrFin = InsertRowElab(arr, arrInsR, 3) 'inserted row to be the third
   sh.[J10].Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
End Sub

Private Function InsertRowElab(arr As Variant, arrIns As Variant, insRowNo As Long) As Variant 'it inserts a row
   Dim i&, k&, Ar, arrR, arrRows, arrCols
   
   arrR = Application.Transpose(Application.Evaluate("row(1:" & UBound(arr) & ")")) 'build the rows array
    Debug.Print "Joined rows array: " & Join(arrR, "#"):                                        'so the joined array looks
   arrRows = Split(Replace(Join(arrR, "|"), insRowNo - 1 & "|", insRowNo - 1 & "|0|"), "|")      'insert the row, placing 0 in the array
    Debug.Print "Joined rows array containing the inserted row (0): " & Join(arrRows, "#")       'so the joined array containing the new row (0) looks
   arrCols = Application.Transpose(Application.Evaluate("row(1:" & UBound(arr, 2) & ")")) 'Array(1, 2, 3)
   Ar = Application.Index(arr, Application.Transpose(arrRows), arrCols)
   'fill the inserted row:
   For i = LBound(Ar) To UBound(Ar, 2): Ar(insRowNo, i) = arrIns(1, i): Next i
   InsertRowElab = Ar
End Function