在VBA中合併多維數組excel

Question

對於redim函數和多維數組，我有一個非常艱難的時間。我試圖將兩個多維數組合併成一個。我知道每個數組的第二個維度總是2，但第一個維度會改變。當我使用redim函數時，我沒有收到錯誤消息，但它首先清除了第一個數組中的所有內容。當我使用redim保留時，我得到一個下標超出範圍。幫幫我。

Function merge_arrays2(first_array As Variant, sec_array As Variant) As Variant 

Dim i As Integer, j As Integer, m As Integer 

m = UBound(sec_array) 
j = UBound(first_array) 

ReDim first_array(m + j, 2) 

For i = 1 To UBound(sec_array) 
j = j + 1 
first_array(j, 1) = sec_array(i, 1) 
first_array(j, 2) = sec_array(i, 2) 
Next 

merge_arrays2 = first_array 

End Function 

Answer 1

沒關係。我解決了這個問題。

Dim i As Integer, j As Integer, k As Integer, third_array(), m As Integer 

m = UBound(sec_array) 
j = UBound(first_array) 

ReDim third_array(m + j, 2) 

For i = 1 To UBound(first_array) 
k = k + 1 
third_array(k, 1) = first_array(i, 1) 
third_array(k, 2) = first_array(i, 2) 
Next 

For i = 1 To UBound(sec_array) 
k = k + 1 
third_array(k, 1) = sec_array(i, 1) 
third_array(k, 2) = sec_array(i, 2) 
Next 

merge_arrays2 = third_array 

Answer 2

請看下面的代碼。有在Redimming問題，並在功能上也聲明

Sub test() 

Dim a() As Variant 
Dim b() As Variant 
Dim c() As Variant 


ReDim a(1, 2) 
ReDim b(1, 2) 
i = 0 
Do While i < 2 
    j = 0 
    Do While j < 3 
     a(i, j) = 1 
     b(i, j) = 2 
     j = j + 1 
    Loop 
    i = i + 1 
Loop 

c() = merge_arrays2(a, b) 

End Sub 

Function merge_arrays2(first_array() As Variant, sec_array() As Variant) As Variant() 

Dim i As Integer, j As Integer, m As Integer, n As Integer 

m = UBound(sec_array, 2) 
n = UBound(first_array, 2) 


ReDim Preserve first_array(1, m + n + 1) 

For j = n + 1 To m + n + 1 
    For i = 0 To UBound(sec_array, 1) 
     first_array(i, j) = sec_array(i, j-n-1) 
    Next 
Next 
merge_arrays2 = first_array 

End Function 

Answer 3

當您使用ReDim，你實際上是重新標註不保留其元素的數組。
使用Preserve保留了這些元素，從而解決了數組元素的刪除問題。
問題是，您只能重新維度數組的最後一個維度，而不是第一維度。
所以你得到下標超出範圍錯誤。 See here MSDN

調整大小與保留。如果使用Preserve，則只能調整數組的最後一個維度。對於其他維度，您必須指定現有數組的邊界。

的一種方法是，你已經張貼什麼作爲答案，另一種方式是以下（僅適用於小數組）：

Function merge2Darray(arr1, arr2) As Variant 
    Dim tarr 
    tarr = Application.Transpose(arr1) 
    Dim i As Long 
    For i = LBound(arr2, 1) To UBound(arr2, 1) 
     ReDim Preserve tarr(1 To 2, 1 to UBound(tarr, 2) + 1) 
     tarr(1, UBound(tarr, 2)) = arr2(i, 0) 
     tarr(2, UBound(tarr, 2)) = arr2(i, 1) 
    Next 
    merge2Darray = Application.Transpose(tarr) 
End Function 

注意到，Application.Transpose方法有侷限性。
您只能在小尺寸陣列（幾千）上使用它。