arrays - 将垂直切片插入数组

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

相关评论问:

"I can slice a 2D array, I can eliminate column, reorder columns, but I cannot ►insert a column(s) slice in such an array... In fact, I can do it using iteration, but did you find a similar way to insert such a vertical slice?"

有条不紊的提示
至少众所周知，给定的列(例如第 4 列)可以从数组(例如 data )通过

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

产生一个基于 1 的 2 维“垂直”数组。
它是 不是 但是可以将垂直切片分配给另一个切片；以下代码将引发 1004 错误(应用程序定义或对象定义错误):

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

问题

Is there any possibility to insert a column(s) slice in an array (without iteration)?

确实存在将此类列数据排列在临时数组数组(“锯齿状数组”)中并从该基础构建 2-dim 数组的可能性。
为了不过度收费这篇文章，我将展示这种相当未知的方法作为►单独的答案期待任意 其他或更好的方法。
相关链接
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 参数引用的帖子中的基本方法。功能，但首先将一个(例如临时)列插入到物理数据范围，最终通过重新排列包含新添加的额外数据(最后一个位置)的列在任何新位置(例如，在顶部)。

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

针对最近评论的解决方法附录 //编辑/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