如何在VBA中的现有矩阵中添加计数器列？

Przemyslaw Remin

如何在VBA中使用第一个“列”中的计数器值获取新矩阵。假设我们有一个VBA矩阵，该矩阵的值是从单元格中获取的。A1单元格的值就是“ A1”。

Dim matrix As Variant
matrix = Range("A1:C5").value

输入矩阵：

+----+----+----+
| A1 | B1 | C1 |
+----+----+----+
| A2 | B2 | C2 |
+----+----+----+
| A3 | B3 | C3 |
+----+----+----+
| A4 | B4 | C4 |
+----+----+----+
| A5 | B5 | C5 |
+----+----+----+

我想在VBA矩阵的第一列中获得带有计数器值的新矩阵。

这是理想的结果：

+----+----+----+----+
|  1 | A1 | B1 | C1 |
+----+----+----+----+
|  2 | A2 | B2 | C2 |
+----+----+----+----+
|  3 | A3 | B3 | C3 |
+----+----+----+----+
|  4 | A4 | B4 | C4 |
+----+----+----+----+
|  5 | A5 | B5 | C5 |
+----+----+----+----+

一种实现方法是循环。还有其他更优雅的方法吗？我们在这里处理大型数据集，因此请注意性能。

弗洛伦特·B。

如果您最关心的是性能，请使用Redim Preserve末尾添加一个新列，并使用OS API将每个列直接移入内存中：

Private Declare PtrSafe Sub MemCpy Lib "kernel32" Alias "RtlMoveMemory" ( _
  ByRef dst As Any, ByRef src As Any, ByVal size As LongPtr)

Private Declare PtrSafe Sub MemClr Lib "kernel32" Alias "RtlZeroMemory" ( _
  ByRef src As Any, ByVal size As LongPtr)


Sub AddIndexColumn()
  Dim arr(), r&, c&
  arr = [A1:F1000000].Value

  ' add a column at the end
  ReDim Preserve arr(LBound(arr) To UBound(arr), LBound(arr, 2) To UBound(arr, 2) + 1)

  ' shift the columns by 1 to the right
  For c = UBound(arr, 2) - 1 To LBound(arr, 2) Step -1
    MemCpy arr(LBound(arr), c + 1), arr(LBound(arr), c), (UBound(arr) - LBound(arr) + 1) * 16
  Next
  MemClr arr(LBound(arr), LBound(arr, 2)), (UBound(arr) - LBound(arr) + 1) * 16

  ' add an index in the first column
  For r = LBound(arr) To UBound(arr)
    arr(r, LBound(arr, 2)) = r
  Next

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。