将垂直切片插入数组

Question

在最近的 post 中，我演示了如何在 Application.Index() 函数中使用 数组参数（而不是单个索引） 以任意方向重新排列当前列的顺序（切换列、省略/删除列）。

    Application.Index(data, {vertical rows array}, {horizontal columns array})

这种方法不需要循环，并且允许仅通过在 OP 中列出新列位置来定义任何新列顺序，例如通过

     Array(1, 4, 2)

换句话说

• 第一列，
• （第三个省略=删除），
• 剩余的第 4 列和第 2 列按顺序交换*：

Sub DeleteAndSwitch()
'[1]get data
    Dim data: data = Sheet1.Range("A1:D4")
'[2]reorder columns via Array(1, 4, 2), i.e. get 1st column, 4th and 2nd column omitting the 3rd one
'   (evaluation gets all existing rows as vertical 2-dim array)
    data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), Array(1, 4, 2))
'[3]write to any target
    Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

询问相关评论：

“我可以切片一个二维数组，我可以消除列，重新排序列，但我不能►在这样的数组中插入列切片... 其实我可以用迭代来做，但是你有没有找到类似的方法来插入这样一个垂直切片？”

有条不紊的提示

至少众所周知，给定的列（例如第 4 列）可以通过

从数组（例如 data）中切分出来

    Column4Data = Application.Index(data, 0, 4)

产生一个基于 1 的二维“垂直”数组。

不可能，但是将垂直切片分配给另一个切片；以下代码会引发 1004 错误（应用程序定义的或对象定义的错误）：

Application.Index(data, 0, 4) = Application.Index(data, 0, 1)

问题

是否有任何可能在数组中插入列切片（无需迭代）？

确实存在将此类列数据排列在一个临时数组数组中的可能性（“锯齿状数组”），并以此为基础构建一个二维数组。

为了不过度收费这篇文章，我将展示这种相当未知的方法作为►单独的答案，期待任何其他或更好的方法。

相关链接 Some pecularities of the Application.Index() function

Answer 1

使用Application.Index()的锯齿状数组方法

为了完整起见，我展示这种方法是为了证明Application.Index() 函数的进一步且广泛未知的可能性。

通过首先将（转置）切片添加到临时“数组数组”，可以在第二步中通过 双零 参数创建一个二维数组使用以下语法（参见 [2]b 部分）：

    data = Application.Transpose(Application.Index(data, 0, 0))

Sub InsertSlices()
'Auth: https://stackoverflow.com/users/6460297/t-m
'[0]define extra array (or slice AND transpose from other data source)
    Dim Extra: Extra = Array(100, 200, 300, 400)   ' example data
'[1]get data
    Dim data: data = Tabelle7.Range("A1:D4")
'[2]a) rewrite data as 1-dim array of sliced column arrays
    data = Array(Extra, Slice(data, 1), Slice(data, 4), Slice(data, 2))
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'[2]b) rebuild as 2-dim array
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    data = Application.Transpose(Application.Index(data, 0, 0))
'[3]write to any target
    Tabelle7.Range("F1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

Function Slice(DataArr, ByVal colNo As Long) As Variant()
'Purpose: return entire column data as 2-dim array and
'         transpose them here to get a "flat" 1-dim array of column data
With Application
    Slice = .Transpose(.Index(DataArr, 0, colNo))
End With
End Function

警告： 对于较大的数据集，分两步重复转换数据可能会很耗时。

---

解决方法

因此，我更喜欢通过 Application.Index() 函数中的 ►array arguments 引用帖子中的基本方法，但是通过将（例如临时）列插入到物理数据范围 首先并最终通过在任何新位置（例如，在顶部）重新排列包含新添加的额外数据（最后位置）的列。

Sub DelSwitchAndInsert()
'Auth: https://stackoverflow.com/users/6460297/t-m
'[0]add other array data as last column to existing range
    Sheet1.Range("E1:E4") = Application.Transpose(Array(1, 2, 3, 4))
'[1]get data
    Dim data: data = Tabelle7.Range("A1:E4")
'[2]reorder via Array(1, 4, 2), i.e. get 1st column, 4th and 2nd column omitting the 3rd one
    data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), Array(UBound(data, 2), 1, 4, 2))
'[3]write to any target
    Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

针对最近的 cmets 的解决方法附录 //Edit/2020-07-07

在任何给定的“列”编号处插入垂直额外单列数据的解决方法逻辑的灵活示例如下；我不会假装这既不是最好的方法也不是最好的编码方式：

    InsCol data, extra, 3        ' insertion e.g. as new 3rd "column"

Sub InsertExtraData()
'Purpose:  insert a single-column array (2-dim, 1-based)
    '[0]define extra array (or slice AND transpose from other data source)
        Dim extra: extra = Application.Transpose(Array(100, 200, 300, 400))   ' example data
    '[1]get data (or existing 2-dim array)
        Dim data: data = Sheet1.Range("A1:D4")
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '[2]insert extra as >>3rd<< column
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        InsCol data, extra, 3
    '[3]write to any target
        Sheet2.Range("A1").Resize(UBound(data), UBound(data, 2)) = data
End Sub

Sub InsCol(data, extra, Optional ByVal colNo As Long = 1)
With Sheets.Add
    '[0]add data to temporary range
    .Range("B1").Resize(UBound(data), UBound(data, 2)) = data
    .Range("B1").Offset(0, UBound(data, 2)).Resize(UBound(extra) - LBound(extra) + 1, 1) = extra
    '[1]get data
        data = .Range("B1").Resize(UBound(data), UBound(data, 2) + 1)
    '[2]reorder via Array(5, 1, 2, 3, 4)
        data = Application.Index(data, Evaluate("row(1:" & UBound(data) & ")"), getColNums(data, colNo))
    '[3]delete temporary sheet
        Application.DisplayAlerts = False: .Delete
        Application.DisplayAlerts = True
End With
End Sub

Function getColNums(main, Optional ByVal colNo As Long = 1) As Variant()
    'c.f. : https://stackoverflow.com/questions/53727578/joining-two-arrays-in-vba/60082345#60082345
    'Purp.: return ordinal element counters of combined 0-based 1-dim arrays
    Dim i&, n&: n = UBound(main) + 1    ' +1 as one column, +1 from 0-based~>one-based
    ReDim tmp(0 To n - 1)               ' redim to augmented size (zero-based)
    If colNo > n Then colNo = n
    If colNo < 1 Then colNo = 1
    For i = 0 To colNo - 1: tmp(i) = i + 1: Next i
    tmp(colNo - 1) = n
    For i = colNo To UBound(tmp): tmp(i) = i: Next i
    getColNums = tmp        ' return combined elem counters,  e.g. Array(1,2, >>5<< ,3,4)
End Function