Excel VBA 将新行插入数组

Question

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

数组已经有了现有的信息，所以如果我想简单地将新信息放在中间，ReDim Preserve 就无法正常工作。

有什么想法吗？

Answer 1

请尝试下一种方式：

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

Answer 2

假设两个 1-based 2-dim 数据字段输入，我演示了@FaneDuru 的有效方法的替代方法，使用单独的 组合列表 创建为 数据容器 并允许通过现在不可靠的 .AddItem 方法 .

进行简单的项目插入

注意当然，这种方法可以在许多方面进行改进，例如通过允许输入数组使用不同的索引基础。 - 方法提示： 分配从零开始的组合的 .Column 属性（即倒置的 .List 道具）并将其转回允许这里重新获得输入数组的原始基于 1 的索引作为 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 3

正在重播@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

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

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

Excel VBA 将新行插入数组

Excel VBA Insert New Row into an Array

arrays

excel

vba

row

insert