在VBA excel中合并多维数组

时间:2014-09-21 16:28:42

标签: arrays vba excel-vba merge excel

我使用redim函数和多维数组非常困难。我正在尝试将两个多维数组合并为一个。我知道每个数组的第二个维度总是2,但第一个维度会改变。当我使用redim函数时,我没有收到错误消息,但它首先删除了第一个数组中的所有内容。当我使用redim preserve时,我得到一个超出范围的下标。帮助

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

3 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

查看以下代码。 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

答案 2 :(得分:0)

当您使用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 方法有局限性 你只能在小尺寸阵列上使用它(几千个)。