如何在VBA中合并两个数组？

Question

给定

Dim arr1 As Variant
Dim arr2 As Variant
Dim arr3 As Variant

arr1 = Array("A", 1, "B", 2)
arr2 = Array("C", 3, "D", 4)

问题

我可以对arr1和arr2执行哪些操作并将结果分配给arr3，以获得类似以下的东西：

arr3 = ("A", "C", 1, 3, "B", "D", 2, 4)

提示 (由于评论所述): "1） arr1 中的元素是名称，而在 arr2 中是值，在 arr3 中的最终元素实际上是名称-值对，只要它们匹配，我就不在乎它们是否有序。"

- Kevin Boyd

---

两个问题：（1）合并后的数组中元素的顺序是否重要？（2）如果相同的值在两个数组中都出现，您是否想要消除重复项？ - JohnFx

1. arr1中的元素是名称，arr2中的元素是值，最终在arr3中的元素实际上是名称-值对，只要它们成对出现，我就不会在意它们是否按顺序排列。希望这回答了你的问题。
2. 我认为第一点已经回答了这个问题，我会在其他地方处理重复的名称。

- Kevin Boyd

Answer 1

试试这个：

arr3 = Split(Join(arr1, ",") & "," & Join(arr2, ","), ",") 

- user3286479

---

例如，如果数组包含逗号，可以使用 Split(Join(arr1, Chr(1)) & Chr(1) & Join(arr2, Chr(1)), Chr(1))。 - Malan Kriel

FYI，已发布对您出色的解决方案的扩展，使用新的 ArrayToText() 函数，并允许将数值返回作为进一步的好处。@user3286479 - T.M.

Answer 2

遗憾的是，VB6中的数组类型并没有那么多高端的功能。你几乎只能通过迭代数组并手动将它们插入第三个数组中来完成操作。

假设这两个数组长度相同。

Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant

arr1() = Array("A", 1, "B", 2)
arr2() = Array("C", 3, "D", 4)

ReDim arr3(UBound(arr1) + UBound(arr2) + 1)

Dim i As Integer
For i = 0 To UBound(arr1)
    arr3(i * 2) = arr1(i)
    arr3(i * 2 + 1) = arr2(i)
Next i

更新：已修复代码。对之前的有bug版本感到抱歉。花费了几分钟时间才获得VB6编译器权限进行检查。

- JohnFx

---

将UBounds相加会导致大小偏差一，而且写入输出数组的索引应该与读取源数组的索引分开。让这成为一个关于使用VBA数组时有多烦人的教训！ - jtolle

仅就令人烦恼的VBA数组进行阐述...特别是在结合Excel和VBA时，你需要知道的主要事情是数组可以具有任意下限。如果你没有指定一个，则LB由Option Base设置。但是使用Array()和ParamArrays创建的数组始终具有0的LB。从Excel传递的数组始终具有1的LB。当迭代单个数组时，这并不重要-使用ForEach或LBound和UBound-但是同时使用两个数组工作，突然意味着你必须考虑边界和索引等细节... - jtolle

我不建议这样做，但是如果你使用 Option Base 1，默认的 LB 可以设置为 1。 - Mike Woodhouse

我真的很讨厌“Option Base”。它就像是一种神秘的远程操作，逐个模块地进行，只是为了避免输入下限。虽然我知道它在VB/VBA之前存在，并且曾经很重要... - jtolle

我在上面的评论中关于使用Array()创建的数组的LB是错误的。它确实受Option Base设置的影响，但ParamArrays则不受影响。 - jtolle

Answer 3

我尝试了上面提供的代码，但是对我来说它报错了9。 我写了这段代码，它很好地满足了我的需求。我希望其他人也会觉得它有用。

Function mergeArrays(ByRef arr1() As Variant, arr2() As Variant) As Variant

    Dim returnThis() As Variant
    Dim len1 As Integer, len2 As Integer, lenRe As Integer, counter As Integer
    len1 = UBound(arr1)
    len2 = UBound(arr2)
    lenRe = len1 + len2
    ReDim returnThis(1 To lenRe)
    counter = 1

    Do While counter <= len1 'get first array in returnThis
        returnThis(counter) = arr1(counter)
        counter = counter + 1
    Loop
    Do While counter <= lenRe 'get the second array in returnThis
        returnThis(counter) = arr2(counter - len1)
        counter = counter + 1
    Loop

mergeArrays = returnThis
End Function

- Johannes

Answer 4

这个函数将按照JohnFx的建议执行，并允许数组长度不同。

Function mergeArrays(ByVal arr1 As Variant, ByVal arr2 As Variant) As Variant
    Dim holdarr As Variant
    Dim ub1 As Long
    Dim ub2 As Long
    Dim bi As Long
    Dim i As Long
    Dim newind As Long

        ub1 = UBound(arr1) + 1
        ub2 = UBound(arr2) + 1

        bi = IIf(ub1 >= ub2, ub1, ub2)

        ReDim holdarr(ub1 + ub2 - 1)

        For i = 0 To bi
            If i < ub1 Then
                holdarr(newind) = arr1(i)
                newind = newind + 1
            End If

            If i < ub2 Then
                holdarr(newind) = arr2(i)
                newind = newind + 1
            End If
        Next i

        mergeArrays = holdarr
End Function

- Buggabill

---

注意：如果有人发现这个问题...它实际上是合并数组...如果元素的顺序对您很重要，那么它不会保留元素的顺序。 - seadoggie01

Answer 5

如果 Lbound 的值不是0或1，它也可以工作。在开始时只需 Redim 一次即可。

Function MergeArrays(ByRef arr1 As Variant, ByRef arr2 As Variant) As Variant

'Test if not isarray then exit
If Not IsArray(arr1) And Not IsArray(arr2) Then Exit Function

Dim arr As Variant
Dim a As Long, b As Long 'index Array
Dim len1 As Long, len2 As Long 'nb of item

'get len if array don't start to 0
len1 = UBound(arr1) - LBound(arr1) + 1
len2 = UBound(arr2) - LBound(arr2) + 1

b = 1 'position of start index
'dim new array
ReDim arr(b To len1 + len2)
'merge arr1
For a = LBound(arr1) To UBound(arr1)
    arr(b) = arr1(a)       
    b = b + 1 'move index
Next a
'merge arr2
For a = LBound(arr2) To UBound(arr2)
    arr(b) = arr2(a)
    b = b + 1 'move index
Next a

'final
MergeArrays = arr

End Function

- GeoStoneMarten

Answer 6

我希望能够借鉴用户3286479的好主意，使其适用于来自单列范围的数组：

Dim ws As Worksheet
Set ws = ActiveSheet
arr1 = ws.Range("A2:A10").Value2
arr2 = ws.Range("B2:B6").Value2
    
arr3 = Split(Join(Application.Transpose(arr1), ",") & "," & Join(Application.Transpose(arr2), ","), ",")

- tiagoalsimao

Answer 7

很遗憾，使用VBA无法像许多现代语言（如Java或Javascript）那样一次性地进行数组元素的追加/合并/插入/删除操作，只能逐个元素进行操作。

虽然可以使用split和join方法来实现，就像之前的回答所展示的那样，但这是一种缓慢的方法，而且不够通用。

为了满足我的个人需求，我已经实现了一个针对1D数组的splice函数，类似于Javascript或Java。该splice函数接受一个数组，并可选择从给定位置删除一些元素，以及可选择在该位置插入一个数组。

'*************************************************************
'*                      Fill(N1,N2)
'* Create 1 dimension array with values from N1 to N2 step 1
'*************************************************************
Function Fill(N1 As Long, N2 As Long) As Variant
Dim Arr As Variant
If N2 < N1 Then
  Fill = False
  Exit Function
End If
Fill = WorksheetFunction.Transpose(
          Evaluate("Row(" & N1 & ":" & N2 & ")"))
End Function
'**********************************************************************
'*                        Slice(AArray, [N1,N2])
'* Slice an array between indices N1 to N2
'***********************************************************************
Function Slice(VArray As Variant, Optional N1 As Long = 1, 
               Optional N2 As Long = 0) As Variant
Dim Indices As Variant
If N2 = 0 Then N2 = UBound(VArray)
If N1 = LBound(VArray) And N2 = UBound(VArray) Then
   Slice = VArray
Else
  Indices = Fill(N1, N2)
  Slice = WorksheetFunction.Index(VArray, 1, Indices)
End If
End Function
'************************************************
'*                 AddArr(V1,V2, [V3])
'* Concatena 2 ou 3 vetores
'**************************************************
Function AddArr(V1 As Variant, V2 As Variant, 
  Optional V3 As Variant = 0, Optional Sep = "#") As Variant
Dim Arr As Variant
Dim Ini As Integer
Dim N As Long, K As Long, I As Integer
  Arr = V1
  Ini = UBound(Arr)
  N = UBound(V1) - LBound(V1) + 1 + UBound(V2) - LBound(V2) + 1
  ReDim Preserve Arr(N)
  K = 0
  For I = LBound(V2) To UBound(V2)
    K = K + 1
    Arr(Ini + K) = V2(I)
  Next I
If IsArray(V3) Then
  Ini = UBound(Arr)
  N = UBound(Arr) - LBound(Arr) + 1 + UBound(V3) - LBound(V3) + 1
  ReDim Preserve Arr(N)
  K = 0
  For I = LBound(V3) To UBound(V3)
    K = K + 1
    Arr(Ini + K) = V3(I)
  Next I
End If
AddArr = Arr
End Function

'**********************************************************************
'*                        Slice(AArray,Ind, [ NElme, Vet] )
'* Delete NELEM (default 0) element from position IND in VARRAY
'* and optionally insert an array VET in that postion
'***********************************************************************
Function Splice(VArray As Variant, Ind As Long, 
  Optional NElem As Long = 0, Optional Vet As Variant = 0) As Variant
Dim V1, V2
If Ind < LBound(VArray) Or Ind > UBound(VArray) Or NElem < 0 Then
  Splice = False
  Exit Function
End If
V2 = Slice(VArray, Ind + NElem, UBound(VArray))
If Ind > LBound(VArray) Then
  V1 = Slice(VArray, LBound(VArray), Ind - 1)
  If IsArray(Vet) Then
     Splice = AddArr(V1, Vet, V2)
  Else
     Splice = AddArr(V1, V2)
  End If
Else
  If IsArray(Vet) Then
     Splice = AddArr(Vet, V2)
  Else
     Splice = V2
  End If
End If

End Function

用于测试

Sub TestSplice()
Dim V, Res
Dim J As Integer
V = Fill(100, 109)
Res = Splice(V, 2, 2, Array(201, 202))
PrintArr (Res)
End Sub

'************************************************
'*                 PrintArr(VArr)
'* Print the array VARR
'**************************************************
Function PrintArr(VArray As Variant)
Dim S As String
S = Join(VArray, ", ")
MsgBox (S)
End Function

结果是

100,201,202,103,104,105,106,107,108,109

- Paulo Buchsbaum

Answer 8

参考@johannes的解决方案，但合并时不会丢失数据（它缺少第一个元素）：

    Function mergeArrays(ByRef arr1() As Variant, arr2() As Variant) As Variant

    Dim returnThis() As Variant
    Dim len1 As Integer, len2 As Integer, lenRe As Integer, counter As Integer
    len1 = UBound(arr1)
    len2 = UBound(arr2)
    lenRe = len1 + len2 + 1
    ReDim returnThis(0 To lenRe)
    counter = 0

    For counter = 0 To len1 'get first array in returnThis
        returnThis(counter) = arr1(counter)
    Next


    For counter = 0 To len2 'get the second array in returnThis
        returnThis(counter + len1 + 1) = arr2(counter)
    Next
mergeArrays = returnThis
End Function

- Felipe Maion

Answer 9

我更喜欢的方法有点长，但比其他答案具有一些优点：

• 它可以同时组合无限数量的数组
• 它可以将数组与非数组（对象、字符串、整数等）组合在一起
• 它考虑到一个或多个数组可能包含对象的可能性
• 它允许用户选择新数组的基础（0、1等）

以下是代码：

Function combineArrays(ByVal toCombine As Variant, Optional ByVal newBase As Long = 1)
'Combines an array of one or more 1d arrays, objects, or values into a single 1d array
'newBase parameter indicates start position of new array (0, 1, etc.)
'Example usage:
    'combineArrays(Array(Array(1,2,3),Array(4,5,6),Array(7,8))) -> Array(1,2,3,4,5,6,7,8)
    'combineArrays(Array("Cat",Array(2,3,4))) -> Array("Cat",2,3,4)
    'combineArrays(Array("Cat",ActiveSheet)) -> Array("Cat",ActiveSheet)
    'combineArrays(Array(ThisWorkbook)) -> Array(ThisWorkbook)
    'combineArrays("Cat") -> Array("Cat")

    Dim tempObj As Object
    Dim tempVal As Variant

    If Not IsArray(toCombine) Then
        If IsObject(toCombine) Then
            Set tempObj = toCombine
            ReDim toCombine(newBase To newBase)
            Set toCombine(newBase) = tempObj
        Else
            tempVal = toCombine
            ReDim toCombine(newBase To newBase)
            toCombine(newBase) = tempVal
        End If
        combineArrays = toCombine
        Exit Function
    End If

    Dim i As Long
    Dim tempArr As Variant
    Dim newMax As Long
    newMax = 0

    For i = LBound(toCombine) To UBound(toCombine)
        If Not IsArray(toCombine(i)) Then
            If IsObject(toCombine(i)) Then
                Set tempObj = toCombine(i)
                ReDim tempArr(1 To 1)
                Set tempArr(1) = tempObj
                toCombine(i) = tempArr
            Else
                tempVal = toCombine(i)
                ReDim tempArr(1 To 1)
                tempArr(1) = tempVal
                toCombine(i) = tempArr
            End If
            newMax = newMax + 1
        Else
            newMax = newMax + (UBound(toCombine(i)) + LBound(toCombine(i)) - 1)
        End If
    Next
    newMax = newMax + (newBase - 1)

    ReDim newArr(newBase To newMax)
    i = newBase
    Dim j As Long
    Dim k As Long
    For j = LBound(toCombine) To UBound(toCombine)
        For k = LBound(toCombine(j)) To UBound(toCombine(j))
            If IsObject(toCombine(j)(k)) Then
                Set newArr(i) = toCombine(j)(k)
            Else
                newArr(i) = toCombine(j)(k)
            End If
            i = i + 1
        Next
    Next

    combineArrays = newArr

End Function

- Daniel McCracken

Answer 10

要将Array1和Array2连接起来，需要创建一个新的数组，命名为JointArray。

Dim JointArray As Variant
ReDim JointArray(UBound(Array1) + UBound(Array2) + 1) As Variant
For i = 0 To UBound(JointArray)
    If i <= UBound(Array1) Then
    JointArray(i) = Array1(i)
    Else
    JointArray(i) = Array2(i - UBound(Array1) - 1)
    End If
Next

- Naresh

---

适用于两个一维数组，大小可以相同或不同。可以使用“Debug.Print Join(Array1, ",") Debug.Print Join(Array2, ",") Debug.Print Join(JointArray, ",")”来检查结果。 - Naresh