是否有办法在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