VBA多维数组



是否有办法在VBA中执行以下操作?

初始化一个多维数组并用一系列数字填充它,

 1  2  3  4  5 
 6  7  8  9 10
11 12 13 14 15
16 17 18 19 20

然后删除一些特定的列,例如:列1 2 4。因此,最终结果只是第3和第5列。

最后如何将最终输出转换为普通的一维数组

假设Excel工作表中有这些列。如果你只在这些列中有这些数据,你可以简单地删除你需要的列:D然后你将最终得到你想要的两列。在不知道你最后真正需要什么的情况下,这是最好的盲目猜测。

。你的列从B到F开始:

Columns("B:B").Delete Shift:=xlToLeft
Columns("C:C").Delete Shift:=xlToLeft
Columns("D:D").Delete Shift:=xlToLeft

可以使用相同的逻辑来处理数组。

  • 将数组转置到工作表中。
  • 删除列。
  • 然后将左边的两列转置为array。

但是如果不将最后两列放入工作表中,您将如何处理它呢?很好奇。所以请确认你需要什么,这样这里的人可以帮助你。

按OP的注释编辑:

你可以看一下这篇文章和文章,它以不同的方式操作数组:

  • 基于另一个工作表中列表内容的Excel透明单元格
  • VBA数组

然后,为了在VBA中填充一个2D数组的例子,看看这个:

Dim i As Integer, j As Integer
Dim array2D As Variant, newArray2D as Variant
'-- 0 indexed based array with 2 rows 3 columns
ReDim array2D(0 To 1, 0 To 2)
For i = LBound(array2D, 1) To UBound(array2D, 1)
    For j = LBound(array2D, 1) To UBound(array2D, 1)
        array2D(i, j) = i + j
    Next j
Next i
'--to delete the fastest is to use the above logic (worksheet)
'-- here you don't need to declare/redimentioned the array
'-- as transpose will do it with a 1 indexed based array
newArray2D = WorksheetFunction.Transpose(Sheets(2).Range("B2:D").Value)

要从数组中删除行或列,您必须将希望保留的数据传输到临时数组中,或者覆盖数组中的值。

要转换维度,需要一个循环。

可以在这里找到许多函数和数组示例

下面是一些示例代码,完全完成了问题中的任务,通过循环/直接复制,即没有教育意义,但也试图证明VBA Excel的"切片"函数与Application.WorksheetFunction.Index实际上并没有帮助完成这项任务,即使它可能在其他方面有用:

Public Sub Answer()
    Dim i As Integer, j As Integer
    ' arrA contains the initial 4x5 multidimensional array
    Dim arrA(1 To 4, 1 To 5) As Integer
    For i = 1 To 4
        For j = 1 To 5
            arrA(i, j) = (i - 1) * 5 + j
        Next j
    Next i
    ' arrBv1 and v2 contain the 2x5 subset, just columns 3 and 5
    ' arrBv1 is obtained by direct copy
    Dim arrBv1(1 To 4, 1 To 2) As Variant
    For i = 1 To 4
        arrBv1(i, 1) = arrA(i, 3)
        arrBv1(i, 2) = arrA(i, 5)
    Next i
    ' arrBv2 is obtained by using Excel's "slicing" capability
    Dim arrBv2(1 To 4, 1 To 2) As Integer
    Dim slices(1 To 2) As Variant
    slices(1) = Application.WorksheetFunction.Index(arrA, 0, 3)
    slices(2) = Application.WorksheetFunction.Index(arrA, 0, 5)
    ' but because the slices are actually each 4x1 multidimensional
    ' array, a second loop is required to obtain a data structure
    ' actually equivalent to arrBv1, making this "shortcut" no
    ' shorter for producing a 4x2 array
    For i = 1 To 4
        arrBv2(i, 1) = slices(1)(i, 1)
        arrBv2(i, 2) = slices(2)(i, 1)
    Next i
    ' although arrBv1 and v2 are equivalent, as MsgBox does not appear
    For i = 1 To 4
        For j = 1 To 2
            If arrBv1(i, j) <> arrBv2(i, j) Then
                MsgBox ("equivalence failure with 4x2 arrays")
            End If
        Next j
    Next i
    ' arrCv1 is the 1x8 array obtained by direct copy from the 4x2 array
    Dim arrCv1(1 To 8) As Integer
    For i = 1 To 4
        arrCv1(i) = arrBv1(i, 1)
        arrCv1(i + 4) = arrBv1(i, 2)
    Next i
    ' arrCv2 is the one-dimensional array obtained from the slices, which
    ' does not lead to an additional step, but is not shorter
    ' than just using arrBv1 as immediately above or
    Dim arrCv2(1 To 8) As Integer
    For i = 1 To 4
        arrCv2(i) = slices(1)(i, 1)
        arrCv2(i + 4) = slices(2)(i, 1)
    Next i
    ' arrCv3 is the 1x8 array obtained from the original 4x5 array,
    ' shorter still
    Dim arrCv3(1 To 8) As Integer
    For i = 1 To 4
        arrCv3(i) = arrA(i, 3)
        arrCv3(i + 4) = arrA(i, 5)
    Next i
    ' and arrCv1, v2 and v3 are again all equivalent
    For i = 1 To 8
        If arrCv1(i) <> arrCv2(i) Or arrCv1(i) <> arrCv3(i) Then
            MsgBox ("equivalence failure with one-dimensional array")
        End If
    Next i
    ' so, in sum, nothing.
End Sub

相关内容

  • 没有找到相关文章

最新更新