组合 2D（二维）数组

Question

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

数组1：

a    b    c
d    e    f

数组2：

1    2    3
4    5    6

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

数组3：

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

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

数组4：

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

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

请记住，我上面的示例很小，但实际上，我正在尝试一次处理大约 100,000 行数据。如果重要的话，只有六列数据。

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

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

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

首先，添加数组A：

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 秒。

但是，如果您首先重写并填充数组，然后写入电子表格一次，它会在大约一秒钟内运行。

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

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

约翰·科尔曼在下面的回答效果很好。

我实际上将一些 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

注意：这只是一个演示概念证明。目前它对两个二维数组进行垂直堆叠。修改简单，也可以进行水平堆叠。

注意：我通常反对这种事情，但如果你仔细想想，Excel 工作表类似于一个非常大的二维数组，虽然这确实是一种笨拙的方法，但它很快而且没有迭代！

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