将垂直切片插入数组

Question

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

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

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

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

相关评论问道：

"我可以对 2D 数组进行切片，我可以消除列，对列重新排序，但我无法►在这样的数组中插入列切片...... 事实上，我可以使用迭代来做到这一点，但是您是否找到了类似的方法来插入这样的垂直切片？

有条不紊的提示

至少众所周知，给定的列(例如第 4 列(可以从数组中切片(此处例如data( 通过

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

导致自身形成一个基于 1 的 2 暗淡"垂直"阵列。

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

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

问题

是否有可能在数组中插入列切片(不迭代(？

确实存在将此类列数据排列在临时数组数组("交错数组"(中并从此基础上构建 2-dim 数组的可能性。

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

相关链接Application.Index()功能的一些特点

Answer 1

> 使用Application.Index()的交错数组方法

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

通过首先将(转置(切片添加到临时的"数组数组"中，可以使用以下语法(参见第[2]b节(通过双零参数在第二步中创建一个 2-dim 数组：

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

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