Question

如何在第一个“列”中使用计数器值在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 |
+----+----+----+----+

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

赏金后编辑 感谢大家在这个赏金任务中贡献你的答案和评论。特别感谢Florent B.和Thomas Inzina。

Answer 1

如果主要关注的是性能，那么使用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

Answer 2

方法1

此方法将单元格插入范围的左侧，并设置新单元格公式以计算计数器=ROWS($A$1:$A5)。注意：此模式也用于计算运行总计。

用法

InsertCounter工作表（“Sheet1”）。范围（“A1：C5”）

Sub InsertCounter(Target As Range)
    Dim counterCells As Range
    Target.Columns(1).Insert Shift:=xlToRight
    Set counterCells = Target.Columns(1).Offset(0, -1)
    counterCells.Formula = "=Rows(" & counterCells.Cells(1, 1).Address(True, True) & ":" & counterCells.Cells(1, 1).Address(False, True) & ")"
End Sub

方法2

此方法将Ranges的值复制到一个数组中，创建一个带有1个额外列的新数组，然后将数据和计数器复制到新数组。此方法的不同之处在于它不插入任何单元格。

用法

AddCounterToMatrix工作表（“Sheet1”）。范围（“A1：C5”）

Sub AddCounterToMatrix(Target As Range)
    Dim x As Long, y As Long
    Dim Matrix1 As Variant, NewMatrix1 As Variant
    Matrix1 = Target.Value

    ReDim NewMatrix1(LBound(Matrix1) To UBound(Matrix1), LBound(Matrix1, 2) To UBound(Matrix1, 2) + 1)

    For x = LBound(Matrix1) To UBound(Matrix1)
        NewMatrix1(x, 1) = x - LBound(Matrix1) + 1
        For y = LBound(Matrix1, 2) To UBound(Matrix1, 2)
            NewMatrix1(x, y + 1) = Matrix1(x, y)
        Next
    Next

    Target.Resize(UBound(NewMatrix1) - LBound(Matrix1) + 1, UBound(NewMatrix1, 2) - LBound(NewMatrix1, 2) + 1).Value = NewMatrix1

End Sub

Answer 3

使用动态变体很快。

Sub test()
    Dim matrix As Variant, newMatrix()
    Dim i As Long, n As Long, c As Long, j As Long
    matrix = Range("A1:C5").Value
    n = UBound(matrix, 1)
    c = UBound(matrix, 2)
    ReDim newMatrix(1 To n, 1 To c + 1)
    For i = 1 To n
        newMatrix(i, 1) = i
        For j = 2 To c + 1
            newMatrix(i, j) = matrix(i, j - 1)
        Next j
    Next i
    Range("a1").Resize(n, c + 1) = newMatrix
End Sub

Answer 4

基于excel的解决方案对你来说还可以吗？

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1") = "1"
Range("A2") = "2"
Range("A1:A2").Select
Selection.AutoFill Destination:=Range("A1:A5")

Dim matrix As Variant
matrix = Range("A1:D5").Value

Answer 5

为什么不在家庭补救措施和纯数组脚本之间进行折衷，方法是插入一个临时列并在数组的第一列中完成剩下的工作。

<强>代码

{{1}}

附加说明：也许你可以通过API（CopyMemory）找到一些东西。

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

5 个答案:

方法1

用法

方法2

用法