VBA 使用两个一维数组创建二维数组并调用值来填充参数

Question

我有 2 个数组，我想将它们组合成一个包含所有可能组合的数组。然后我需要遍历函数的所有组合和流行参数。我的数组大小不相等，到目前为止我的尝试导致组合数组只有一对值。这是 PowerPoint 中的 VBA，而不是 Excel，如果这对可用语法有影响的话。

我该怎么办：

arrayColor = Array("Blue","Green","Red")
arraySize = Array("XS","S","M","L","XL")

为此：

arrayCombo(0,0) = "Blue"
arrayCombo(0,1) = "XS"
arrayCombo(1,0) = "Blue"
arrayCombo(1,1) = "S"
...
arrayCombo(15,0) = "Red"
arrayCombo(15,1) = "XL"

然后使用循环调用每对值并填充参数值。这段代码只是为了说明这个概念；这当然不合法。很确定我需要一个嵌套循环？

For i = 0 To UBound(arrayCombo(i))  
    nextSubToFire(color, size)
Next i

这是我目前所得到的，但它只会在我的组合数组中产生一对。它基于 this question，但我想我要么遗漏了什么，要么唯一的答案不太正确。我看过其他类似的问题，但无法用代码中编译的数组而不是其他所有针对 Excel.

量身定制的示例来解决这个问题

Option Explicit
Dim arrayColorSize, arrayCombo

Sub CoreRoutine()
    Dim arrayColor, arraySize
    arrayColor = Array("Blue","Green","Red")
    arraySize = Array("XS","S","M","L","XL")
    arrayColorSize = Array(arrayColor, arraySize)
    arrayCombo = Array(0, 0)
    DoCombinations (0)
    Dim a As Integer
    Dim b As Integer
    'For loop comes next once I figure out how to populate the full arrayCombo
    
End Sub

Sub DoCombinations(ia)
    Dim i
    For i = 0 To UBound(arrayColorSize(ia)) ' for each item
        arrayCombo(ia) = arrayColorSize(ia)(i) ' add this item
        If ia = UBound(arrayColorSize) Then
        Else
            DoCombinations (ia + 1)
        End If
    Next i
End Sub

使用 Locals window，我看到 arrayCombo 存在，但它只有一对值，这是最后一组配对选项。我看到 arrayColorSize 有我期望的 2 个数组集，所以我怀疑 DoCombinations sub 缺少一些东西。

非常感谢任何指导！

Answer 1

这样做的一种方法是将两个一维数组组合成一个具有 2 列的二维数组（如您的示例所示）：

Private Function Combine1DArrays(ByRef arr1 As Variant, ByRef arr2 As Variant) As Variant
    If GetArrayDimsCount(arr1) <> 1 Or GetArrayDimsCount(arr2) <> 1 Then
        Err.Raise 5, "Combine1DArrays", "Expected 1D arrays"
    End If
    '
    Dim count1 As Long: count1 = UBound(arr1) - LBound(arr1) + 1
    Dim count2 As Long: count2 = UBound(arr2) - LBound(arr2) + 1
    Dim i As Long, j As Long, r As Long
    Dim result() As Variant
    '
    ReDim result(0 To count1 * count2 - 1, 0 To 1)
    r = 0
    For i = LBound(arr1) To UBound(arr1)
        For j = LBound(arr2) To UBound(arr2)
            result(r, 0) = arr1(i)
            result(r, 1) = arr2(j)
            r = r + 1
        Next j
    Next i
    Combine1DArrays = result
End Function

Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
    Const MAX_DIMENSION As Long = 60
    Dim dimension As Long
    Dim tempBound As Long
    '
    On Error GoTo FinalDimension
    For dimension = 1 To MAX_DIMENSION
        tempBound = LBound(arr, dimension)
    Next dimension
FinalDimension:
    GetArrayDimsCount = dimension - 1
End Function

您可以像这样使用它，例如：

Sub CoreRoutine()
    Dim arrayColorSize As Variant
    Dim i As Long
    Dim color As String
    Dim size As String
    '
    arrayColorSize = Combine1DArrays(Array("Blue", "Green", "Red") _
                                   , Array("XS", "S", "M", "L", "XL"))
    For i = LBound(arrayColorSize, 1) To UBound(arrayColorSize, 1)
        color = arrayColorSize(i, 0)
        size = arrayColorSize(i, 1)
        NextSubToFire color, size
    Next i
End Sub

Sub NextSubToFire(ByVal color As String, ByVal size As String)
    Debug.Print color, size
End Sub

VBA 使用两个一维数组创建二维数组并调用值来填充参数

VBA Use two 1 dimensional arrays to create 2 dimensional array and call value to populate arguments

arrays

vba

powerpoint