VBA多維數組

Question

有沒有辦法在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列。

最後如何將最終輸出轉換爲普通的一維數組。

Answer 1

假設您在Excel表格中包含這些列。如果你只在這些列中有這些數據，你可以簡單地刪除你需要的列：D然後你將得到你想要的2列。不知道你到底真的需要什麼，這是最好的盲猜。

您的列在B到F處開始：

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

您可以使用相同的邏輯來處理數組。

• 將數組轉換爲表格。
• 刪除列。
• 然後將左上兩列轉置爲數組。

但是，如果不把它放在表單中，最後兩列你會做什麼？非常好奇。所以請確認你需要什麼，這樣任何人都可以幫助你。

編輯按OP的評論：

你可以看看這個帖子和文章，其具有以不同的方式排列的manupulation：

• Excel clear cells based on contents of a list in another sheet
• VBA Arrays

然後，爲了在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) 

Answer 2

要刪除數組中的行或列，您必須將希望保留的數據傳輸到臨時數組，或者覆蓋數組中的值。

要轉換尺寸，將需要一個循環。

大量的功能和數組的例子可以發現here

Answer 3

下面是一些示例代碼，完全實現了在這個問題的任務，通過循環/直接複製，即沒有什麼教育，也嘗試如何彰顯VBA Excel的「切片」與Application.WorksheetFunction.Index功能實際上並沒有完成這個任務的幫助，甚至因爲它可能在其他方面是有用的：

Public Sub Answer() 

    Dim i As Integer, j As Integer 

    ' arrA contains the initial 4x5 multidimensiional 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