arrays - una - ¿Cómo combino dos matrices en VBA?

vb6 array

Question

Dado

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

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

¿Qué tipo de operaciones puedo hacer en arr1 y arr2 y almacenar el resultado en arr3 de modo que:

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

Answer 1

Desafortunadamente, el tipo de matriz en VB6 no tenía tantas características razzmatazz. Tendrás que simplemente iterar a través de las matrices e insertarlas manualmente en la tercera

Suponiendo que ambas matrices tienen la misma longitud

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

Actualizado: corrigió el código. Perdón por la versión anterior de buggy. Me tomó unos minutos obtener acceso a un compilador VB6 para verificarlo.

Answer 2

Esta función hará lo que JohnFx sugirió y permitirá longitudes variadas en los arreglos

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

Answer 3

Probé el código proporcionado anteriormente, pero me dio un error 9. Hice este código, y funcionó bien para mis propósitos. Espero que otros lo encuentren útil también.

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

Answer 4

Funciona si Lbound es diferente de 0 o 1. You Redim una vez al inicio

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

Answer 5

Prueba esto:

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

Answer 6

Mi forma preferida es un poco larga, pero tiene algunas ventajas sobre las otras respuestas:

• Puede combinar un número indefinido de matrices a la vez
• Puede combinar matrices con matrices (objetos, cadenas, enteros, etc.)
• Considera la posibilidad de que una o más de las matrices puedan contener objetos
• Permite al usuario elegir la base de la nueva matriz (0, 1, etc.)

Aquí está:

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