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

相关评论问：

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

系统提示

至少众所周知，可以通过

从数组（此处为data）中切片给定的列（例如第4个列）

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

将自身置于基于1的2维“垂直”数组中。

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

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

问题

是否有种可能性将列切片插入数组（无需迭代）？

确实有可能将此类列数据安排在临时数组数组（<锯齿状数组” ）中，并以此为基础构建2维数组。

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

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

Answer 1

使用Application.Index()

的锯齿阵列方法

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

首先通过将（转置的）切片添加到临时的“数组数组”，第二步可以通过双零参数创建2维数组使用以下语法（参见 [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 引用的文章中的基本方法，但要在物理数据范围内插入（例如临时）列< em> first ，最后将包含新添加的额外数据（最后位置）的列重新排列在任何新位置（例如，此处位于顶部）。

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

变通办法以响应最近的评论 // 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

将垂直切片插入数组

1 个答案: