Question

我在Excel中使用VBA来使用XML文件并将特定信息转储到各个选项卡中。我希望能够组合二维数组。这些数组具有“已知”列数但具有“未知”行数。考虑以下两个数组：

ARRAY1：

a    b    c
d    e    f

数组2：

1    2    3
4    5    6

如果我想要以下结果，如何将这些组合到数组中：

ARRAY3：

a    b    c
d    e    f
1    2    3
4    5    6

只是出于好奇，如果我想要添加到右边而不是底部，我将如何编码，如下所示：

array4：

a    b    c    1    2    3
d    e    f    4    5    6

我似乎无法在任何地方找到答案。

请记住，我上面的示例相当小，但实际上，我正在尝试同时使用大约100,000行数据。如果重要的话，只有六列数据。

这里的目标是组装一个大型数组，然后一步一步地将其写入Excel工作表，因为当我分段执行时，性能非常差。

如果可能的话，我更喜欢不需要迭代的解决方案。

我问两种方式的原因是，实际上我想要顺序添加一种。例如，假设我有四个数组，A，B，C，D。

首先，添加数组A：

然后，添加数组B：

A    B

然后，添加数组C：

A    B
C

然后，添加数组D：

A    B
C    D

依此类推......

请记住，上面的每个数组都会调整大小以使它们“正确”适合“A”和“B”具有相同的行数但列数不同。另一方面，A和C具有相同的列数但行数不同。等等...

我想使用下面的Macro Man代码添加演示。以下是他提供的内容（我添加了一些内容，以便读者可以复制/粘贴）：

Option Explicit

Sub Testing()

    Dim Array1(0 To 1, 0 To 2) As String
    Array1(0, 0) = "a"
    Array1(0, 1) = "b"
    Array1(0, 2) = "c"
    Array1(1, 0) = "d"
    Array1(1, 1) = "e"
    Array1(1, 2) = "f"

    Dim Array2(0 To 1, 0 To 2) As String
    Array2(0, 0) = "1"
    Array2(0, 1) = "2"
    Array2(0, 2) = "3"
    Array2(1, 0) = "4"
    Array2(1, 1) = "5"
    Array2(1, 2) = "6"

    Dim i As Long
    For i = 1 To 25000

        With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
            .Resize(UBound(Array1, 1) - LBound(Array1, 1) + 1, _
                    UBound(Array1, 2) - LBound(Array1, 2) + 1).Value = Array1
        End With

        With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
            .Resize(UBound(Array2, 1) - LBound(Array2, 1) + 1, _
                    UBound(Array2, 2) - LBound(Array2, 2) + 1).Value = Array2
        End With

    Next i

End Sub

当您运行上面的代码时，每次写回少量数据都会返回电子表格，这需要很长时间才能运行。在我的双Xeon机器上，如25-30秒。

但是，如果您重新编写并填充数组FIRST，然后写入电子表格ONCE，它将在大约一秒钟内运行。

Option Explicit

Sub Testing()

    Dim Array1(0 To 99999, 0 To 2) As String
    Array1(0, 0) = "a"
    Array1(0, 1) = "b"
    Array1(0, 2) = "c"
    Array1(1, 0) = "d"
    Array1(1, 1) = "e"
    Array1(1, 2) = "f"

    Dim i As Long
    For i = 0 To 99999

        Array1(i, 0) = "a"
        Array1(i, 1) = "b"
        Array1(i, 2) = "c"

    Next i

    With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
        .Resize(UBound(Array1, 1) - LBound(Array1, 1) + 1, _
                UBound(Array1, 2) - LBound(Array1, 2) + 1).Value = Array1
    End With

End Sub

我希望看到一个解决方案做同样的事情，除了能够添加数据的“块”而不是单个项目。理想情况下，将数组添加到更大的数组。如果“父”数组以某种方式动态调整自身大小，那就更好了。

John Coleman在下面的回答很有效。

我实际上将一些Macro Man与John的test（）子程序结合起来，这会动态地重新调整范围：

Option Explicit

Sub test()
    Dim A As Variant, B As Variant
    ReDim A(0 To 1, 0 To 1)
    ReDim B(0 To 1, 0 To 1)
    A(0, 0) = 1
    A(0, 1) = 2
    A(1, 0) = 3
    A(1, 1) = 4
    B(0, 0) = 5
    B(0, 1) = 6
    B(1, 0) = 7
    B(1, 1) = 8

    Dim Array1 As Variant
    Array1 = Combine(A, B)

    With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
    .Resize(UBound(Array1, 1) - LBound(Array1, 1) + 1, _
            UBound(Array1, 2) - LBound(Array1, 2) + 1).Value = Array1
    End With
End Sub

Answer 1

这是一个VBA函数，可以将两个二维数组合并为一个二维数组。它可以在VBA中使用，也可以直接在Excel中作为数组公式使用。在VBA中迭代是不可避免的，因为语言没有像连接数组这样的原语：

Function Combine(A As Variant, B As Variant, Optional stacked As Boolean = True) As Variant
    'assumes that A and B are 2-dimensional variant arrays
    'if stacked is true then A is placed on top of B
    'in this case the number of rows must be the same,
    'otherwise they are placed side by side A|B
    'in which case the number of columns are the same
    'LBound can be anything but is assumed to be
    'the same for A and B (in both dimensions)
    'False is returned if a clash

    Dim lb As Long, m_A As Long, n_A As Long
    Dim m_B As Long, n_B As Long
    Dim m As Long, n As Long
    Dim i As Long, j As Long, k As Long
    Dim C As Variant

    If TypeName(A) = "Range" Then A = A.Value
    If TypeName(B) = "Range" Then B = B.Value

    lb = LBound(A, 1)
    m_A = UBound(A, 1)
    n_A = UBound(A, 2)
    m_B = UBound(B, 1)
    n_B = UBound(B, 2)

    If stacked Then
        m = m_A + m_B + 1 - lb
        n = n_A
        If n_B <> n Then
            Combine = False
            Exit Function
        End If
    Else
        m = m_A
        If m_B <> m Then
            Combine = False
            Exit Function
        End If
        n = n_A + n_B + 1 - lb
    End If
    ReDim C(lb To m, lb To n)
    For i = lb To m
        For j = lb To n
            If stacked Then
                If i <= m_A Then
                    C(i, j) = A(i, j)
                Else
                    C(i, j) = B(lb + i - m_A - 1, j)
                End If
            Else
                If j <= n_A Then
                    C(i, j) = A(i, j)
                Else
                    C(i, j) = B(i, lb + j - n_A - 1)
                End If
            End If
        Next j
    Next i
    Combine = C
End Function

我用4种不同的方式对它进行了测试。首先，我在电子表格中输入了两个示例数组，并在excel中直接使用Combine作为数组公式：

这里A7：C10包含数组公式

{=combine(A1:C2,A4:C5)}

和A12：F13包含数组公式

{=combine(A1:C2,A4:C5,FALSE)}

然后，我运行了以下子项：

Sub test()
    Dim A As Variant, B As Variant
    ReDim A(0 To 1, 0 To 1)
    ReDim B(0 To 1, 0 To 1)
    A(0, 0) = 1
    A(0, 1) = 2
    A(1, 0) = 3
    A(1, 1) = 4
    B(0, 0) = 5
    B(0, 1) = 6
    B(1, 0) = 7
    B(1, 1) = 8    
    Range("A15:B18").Value = Combine(A, B)
    Range("C15:F16").Value = Combine(A, B, False)    
End Sub

输出：

Answer 2

如果可能的话，我更喜欢不需要迭代的解决方案。

试试这个：

Function Combine(m, n)
    Dim m1&, m2&, n1&, n2&
    m1 = UBound(m, 1): m2 = UBound(m, 2)
    n1 = UBound(n, 1): n2 = UBound(n, 2)
    With Worksheets.Add
        .[a1].Resize(m1, m2) = m
        .[a1].Resize(n1, n2).Offset(m1) = n
        Combine = .[a1].Resize(m1 + n1, m2)
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        .Delete
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End With
End Function

注意：这只是一个展示概念证明的演示。目前它对两个2d阵列进行垂直堆叠。易于修改也可以进行水平堆叠。

注意：我通常反对这种事情，但是如果你考虑一下，Excel表格就像一个非常大的2d阵列，虽然这确实是一个简洁的方法，它很快就有了不是迭代！

Answer 3

您可以尝试重新调整目标的大小以匹配数组的尺寸。有点像：

（假设你的数组被称为'Array1'和'Array2'）......

With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
    .Resize(UBound(Array1, 1) - LBound(Array1, 1) + 1, _
            UBound(Array1, 2) - LBound(Array1, 2) + 1).Value = Array1
End With

With Range("A" & Rows.Count).End(xlUp).Offset(IIf(IsEmpty([A1]), 0, 1), 0)
    .Resize(UBound(Array2, 1) - LBound(Array2, 1) + 1, _
            UBound(Array2, 2) - LBound(Array2, 2) + 1).Value = Array2
End With

组合2D（2维）数组

3 个答案: