另一种方法是使用变体。考虑：
Dim vdaA As Variant
ReDim vdaA(1 To 2)
vdaA(1) = Array(1, 2, 3, 4)
vdaA(2) = Array(5, 6, 7, 8, 9, 10)
Debug.Print vdaA(1)(0) & " " & vdaA(1)(1) & " " & vdaA(1)(2) & " " & vdaA(1)(3)
Debug.Print vdaA(2)(0) & " " & vdaA(2)(1) & " " & vdaA(2)(2) & " " & _
vdaA(2)(3) & " " & vdaA(2)(4) & " " & vdaA(2)(5)
这段代码的输出是：
1 2 3 4
5 6 7 8 9 10
我已将 vdaA 声明为 Variant，然后使用 Redim 将其转换为一维数组。如果你输入ReDim vdaA(1)(0 to 3)，你会得到一个语法错误。但是，您可以将 vdaA(1) 和 vdaA(2) 转换为不同大小的数组，如我所示。或者，您可以将 vdaA(1) 作为 Variant 传递给子例程，并在那里将 ReDim 传递给它。
我已将 vdaA 转换为锯齿状数组。如果您搜索“锯齿状数组”，您可以获得对它们的更完整描述，但我已经为您提供了足够的介绍来回答这个问题。
据我了解，您不需要不同的行来拥有不同的列数，但我相信您可以看到可用的灵活性。您可以将vdaA(1) 传递给将其转换为数组的子例程。然后可以传递vdaA(1)(1) 进行转换。使用递归，您可以声明在运行时所需的任意多维的数组。其他递归例程可以定位特定条目并设置或获取值。
多年前，我确实使用了这种技术，尽管它伤害了我的大脑。我不再拥有该代码，除非没有其他东西可以满足要求，否则我不会推荐它。但是，如果需要，它可以工作。
下面的代码使用了一种更简单的技术。它只处理常规数组，最多处理五个维度。 “五”是任意的，如果需要，代码可以很容易地调整到更大的限制。
在展示代码之前，我想先讨论一下参数数组。过去我很惊讶有多少经验丰富的 VBA 程序员不知道参数数组或它们给你的灵活性。对不起，如果我侮辱了你的知识。
可能的声明是：
Sub MySub(ByRef A As Long, ByVal B As String, ParamArray Z() As Variant)
参数 A 和 B 是固定类型。我可以根据需要设置固定类型参数 C、D、E 等。我的最后一个参数是一个参数数组，这意味着我可以根据需要使用尽可能多的参数来跟踪 A 和 B 的值。以下是该例程的有效调用：
Call MySub(27, "A", 1, "X")
Call MySub(54, "B", 1, "X", 2, "Y")
Call MySub(54, "B", 1, "X", 2, "Y", 3, "Z")
在这些示例中，我对这些额外参数有一个模式。但是，VarType 允许我检查每个参数的类型，因此它们不必遵循简单的模式。
我的一个例程有一个声明：
Sub VdaInit(ByRef Vda As Variant, ParamArray Bounds() As Variant)
有效调用包括：
Call VdaInit(vdaA, 1, 2)
Call VdaInit(vdaA, 1, 2, -1, 4)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15)
Call VdaInit(vdaA, 1, 2, -1, 4, 10, 15, 5, 6)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15, 5, 6, 0, 4)
这些等价于：
ReDim vdaA(1 to 2)
ReDim vdaA(1 to 2, -1 to 4)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15, 5 to 6)
ReDim vdaA(1 to 2, -1 to 4, 10 to 15, 5 to 6, 0 to 4)
其他调用是：
Call VdaStoreValue(vdaA, DateSerial(2014, 1, 7), 2, 4, 15, 5)
Result = VdaGetValue(VdaB, 2, 4, 15, 5, 4)
相当于：
Vda(2, 4, 15, 5) = DateSerial(2014, 1, 7)
Result = VdaB(2, 4, 15, 5, 4)
您只表达了对字符串的兴趣，但通过变体，您可以拥有任何类型而无需额外的努力。
例如，VdaGetValue 背后的代码很简单：
DimMax = NumDim(Vda)
Select Case DimMax
Case 1
VdaGetValue = Vda(Indices(0))
Case 2
VdaGetValue = Vda(Indices(0), Indices(1))
Case 3
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2))
Case 4
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3))
Case 5
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3), Indices(4))
End Select
不优雅但非常简单，如有必要可扩展到 10 或 15 个维度。
下面的代码不包含太多的参数验证，也没有经过全面测试。不过，我认为它充分展示了这种方法。
Option Explicit
Sub Test()
Dim vdaA As Variant
Dim VdaB As Variant
' ReDim vdaA(1 To 2)
' vdaA(1) = Array(1, 2, 3, 4)
' vdaA(2) = Array(5, 6, 7, 8, 9, 10)
' Debug.Print vdaA(1)(0) & " " & vdaA(1)(1) & " " & vdaA(1)(2) & " " & vdaA(1)(3)
' Debug.Print vdaA(2)(0) & " " & vdaA(2)(1) & " " & vdaA(2)(2) & " " & _
' vdaA(2)(3) & " " & vdaA(2)(4) & " " & vdaA(2)(5)
Call VdaInit(vdaA, 1, 2)
Debug.Print "VdaA" & VdaBoundList(vdaA)
Call VdaInit(vdaA, 1, 2, -1, 4)
Debug.Print "VdaA" & VdaBoundList(vdaA)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15)
Debug.Print "VdaB" & VdaBoundList(VdaB)
Call VdaInit(vdaA, 1, 2, -1, 4, 10, 15, 5, 6)
Debug.Print "VdaA" & VdaBoundList(vdaA)
Call VdaInit(VdaB, 1, 2, -1, 4, 10, 15, 5, 6, 0, 4)
Debug.Print "VdaB" & VdaBoundList(VdaB)
Call VdaStoreValue(vdaA, "A", 1, -1, 10, 5)
Call VdaStoreValue(vdaA, 27, 1, -1, 10, 6)
Call VdaStoreValue(vdaA, 5.3, 1, -1, 11, 5)
Call VdaStoreValue(vdaA, DateSerial(2014, 1, 7), 2, 4, 15, 5)
Call VdaStoreValue(VdaB, True, 1, -1, 10, 5, 0)
Call VdaStoreValue(VdaB, "B", 1, -1, 10, 5, 1)
Call VdaStoreValue(VdaB, False, 1, -1, 10, 5, 2)
Call VdaStoreValue(VdaB, 1234, 2, 4, 15, 5, 4)
Debug.Print "VdaA(1, -1, 10, 5) = " & VdaGetValue(vdaA, 1, -1, 10, 5)
Debug.Print "VdaA(1, -1, 10, 6) = " & VdaGetValue(vdaA, 1, -1, 10, 6)
Debug.Print "VdaA(1, -1, 11, 5) = " & VdaGetValue(vdaA, 1, -1, 11, 5)
Debug.Print "VdaA(2, 4, 15, 5) = " & VdaGetValue(vdaA, 2, 4, 15, 5)
Debug.Print "VdaB(1, -1, 10, 5,0) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 0)
Debug.Print "VdaB(1, -1, 10, 5,1) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 1)
Debug.Print "VdaB(1, -1, 10, 5,2) = " & VdaGetValue(VdaB, 1, -1, 10, 5, 2)
Debug.Print "VdaB(2, 4, 15, 5, 4) = " & VdaGetValue(VdaB, 2, 4, 15, 5, 4)
End Sub
Sub VdaInit(ByRef Vda As Variant, ParamArray Bounds() As Variant)
' Vda: A variant which is to be converted to a multi-dimensional array.
' Bounds: One or more pairs of bounds for the dimensions. The number of pairs
' defines the number of dimensions. For each pair, the first value is
' the lower bound and the second is the upper bound.
' This routine creates dimension 1 and calls VdaInitSub to create
' further dimensions
' I use Debug.Assert because I am testing for errors that only the programmer
' should see.
Debug.Assert UBound(Bounds) >= 1 ' Need at least one pair of bounds
Debug.Assert UBound(Bounds) Mod 2 = 1 ' Need even number of bounds
' I do not check that the bounds are valid integers
Select Case UBound(Bounds)
Case 1
ReDim Vda(Bounds(0) To Bounds(1))
Case 3
ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3))
Case 5
ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
Bounds(4) To Bounds(5))
Case 7
ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
Bounds(4) To Bounds(5), Bounds(6) To Bounds(7))
Case 9
ReDim Vda(Bounds(0) To Bounds(1), Bounds(2) To Bounds(3), _
Bounds(4) To Bounds(5), Bounds(6) To Bounds(7), _
Bounds(8) To Bounds(9))
End Select
End Sub
Function VdaBoundList(ByVal Vda As Variant) As String
' Vda: A variant which has been converted to a multi-dimensional array.
' Returns a string of the format: "(L1 to U1, L2 to U3 ... )
' which gives the dounds of each dimension
Dim DimCrnt As Long
Dim DimMax As Long
DimMax = NumDim(Vda)
VdaBoundList = "("
For DimCrnt = 1 To DimMax
VdaBoundList = VdaBoundList & LBound(Vda, DimCrnt) & " to " & UBound(Vda, DimCrnt)
If DimCrnt < DimMax Then
VdaBoundList = VdaBoundList & ", "
End If
Next
VdaBoundList = VdaBoundList & ")"
End Function
Function VdaGetValue(ByRef Vda As Variant, ParamArray Indices() As Variant) As Variant
' Vda: A variant which has been converted to a multi-dimensional array.
' Indices The parameters are the indices of the entry within Vda from which the value is got.
' The number of indices must match the number of dimensions of Vda.
' Example: Result = VdaGetValue(XYZ, 1, 2, 3)
' is equivalent to Result = XYZ(1, 2, 3)
' providing XYZ has three dimensions and 1, 2 and 3 are within the
' bounds of their dimension
Dim DimCrnt As Long
Dim DimMax As Long
DimMax = NumDim(Vda)
Debug.Assert UBound(Indices) = DimMax - 1 ' Wrong number of parameters
'For DimCrnt = 1 To DimMax
' Debug.Assert IsNumeric(indices(DimCrnt - 1)) ' Index must be numeric
' ' Index not within bounds
' Debug.Assert LBound(indices, DimCrnt - 1) <= indices(DimCrnt - 1) And _
' UBound(indices, DimCrnt - 1) >= indices(DimCrnt - 1)
'Next
Select Case DimMax
Case 1
VdaGetValue = Vda(Indices(0))
Case 2
VdaGetValue = Vda(Indices(0), Indices(1))
Case 3
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2))
Case 4
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3))
Case 5
VdaGetValue = Vda(Indices(0), Indices(1), Indices(2), Indices(3), Indices(4))
End Select
End Function
Sub VdaStoreValue(ByRef Vda As Variant, ParamArray ValAndIndices() As Variant)
' Vda: A variant which has been converted to a multi-dimensional array.
' ValAndIndices The first parameter is the value to be stored. Since this is a
' Variant array it can be of any type. The second and subsequent
' parameters are the indices of the entry within Vda into which
' the value is to be stored. The number of indices must match the
' number of dimensions of Vda.
' Example: VdaStoreValue(XYZ, "Example", 1, 2, 3)
' is equivalent to XYZ(1, 2, 3) = "Example"
' providing XYZ has three dimensions and 1, 2 and 3 are within the
' bounds of their dimension
Dim DimCrnt As Long
Dim DimMax As Long
DimMax = NumDim(Vda)
Debug.Assert UBound(ValAndIndices) = DimMax ' Wrong number of parameters
' I do not check the indices are numeric and within the appropriate bounds
Select Case DimMax
Case 1
Vda(ValAndIndices(1)) = ValAndIndices(0)
Case 2
Vda(ValAndIndices(1), ValAndIndices(2)) = ValAndIndices(0)
Case 3
Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3)) = ValAndIndices(0)
Case 4
Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3), _
ValAndIndices(4)) = ValAndIndices(0)
Case 5
Vda(ValAndIndices(1), ValAndIndices(2), ValAndIndices(3), _
ValAndIndices(4), ValAndIndices(5)) = ValAndIndices(0)
End Select
End Sub
Public Function NumDim(ParamArray TestArray() As Variant) As Integer
' Returns the number of dimensions of TestArray.
' If there is an official way of determining the number of dimensions, I cannot find it.
' This routine tests for dimension 1, 2, 3 and so on until it get a failure.
' By trapping that failure it can determine the last test that did not fail.
' Coded June 2010. Documentation added July 2010.
' * TestArray() is a ParamArray because it allows the passing of arrays of any type.
' * The array to be tested is not TestArray but TestArray(LBound(TestArray)).
' * The routine does not validate that TestArray(LBound(TestArray)) is an array. If
' it is not an array, the routine return 0.
' * The routine does not check for more than one parameter. If the call was
' NumDim(MyArray1, MyArray2), it would ignore MyArray2.
Dim TestDim As Integer
Dim TestResult As Integer
On Error GoTo Finish
TestDim = 1
Do While True
TestResult = LBound(TestArray(LBound(TestArray)), TestDim)
TestDim = TestDim + 1
Loop
Finish:
NumDim = TestDim - 1
End Function
编辑新部分解释了参数数组的“问题”并给出了可能的解决方案。
假设我有三个例程 Main、SubA 和 SubB，其中 SubA 和 SubB 都有名为“Param”的参数数组作为它们的唯一参数。进一步假设 SubA 将它从 Main 接收到的 Param Array 传递给 SubB。
在 Main 中，我调用了 SubA：
Call SubA("A", 1, #1/10/2014#, 2.45)
对于 SubA，Param 将有四个条目：
Param(0) = "A"
Param(1) = 1
Param(2) = #1/10/2014#, 2.45
Param(3) = 2.45
如果 SubA 则调用 SubB：
Call SubB(Param)
那么 SubB 的 Param 将不会有四个条目。相反，它将只有一个条目：
Param(0) = Array("A", 1, #1/10/2014#, 2.45)
我称之为嵌套。如果 SubB 只能由 SubA 调用，则可以对 SubB 进行编码以处理嵌套的 Param 数组。但是，如果 SubB 也可以由 Main 调用，它会变得有点混乱。如果您有带有参数数组的 SubC 和 SubD 并且可以从它们的任何父级调用它们，它仍然会变得更加混乱。
我使用以下例程将嵌套到任何深度的参数数组和参数数组转换为一致的格式：
Sub DeNestParamArray(RetnValue() As Variant, ParamArray Nested() As Variant)
' Coded Nov 2010
' Each time a ParamArray is passed to a sub-routine, it is nested in a one
' element Variant array. This routine finds the bottom level of the nesting and
' sets RetnValue to the values in the original parameter array so that other routine
' need not be concerned with this complication.
Dim NestedCrnt As Variant
Dim Inx As Integer
NestedCrnt = Nested
' Find bottom level of nesting
Do While True
If VarType(NestedCrnt) < vbArray Then
' Have found a non-array element so must have reached the bottom level
Debug.Assert False ' Should have exited loop at previous level
Exit Do
End If
If NumDim(NestedCrnt) = 1 Then
If LBound(NestedCrnt) = UBound(NestedCrnt) Then
' This is a one element array
If VarType(NestedCrnt(LBound(NestedCrnt))) < vbArray Then
' But it does not contain an array so the user only specified
' one value; a literal or a non-array variable
' This is a valid exit from this loop
Exit Do
End If
NestedCrnt = NestedCrnt(LBound(NestedCrnt))
Else
' This is a one-dimensional, non-nested array
' This is the usual exit from this loop
Exit Do
End If
Else
Debug.Assert False ' This is an array but not a one-dimensional array
Exit Do
End If
Loop
' Have found bottom level array. Save contents in Return array.
ReDim RetnValue(LBound(NestedCrnt) To UBound(NestedCrnt))
For Inx = LBound(NestedCrnt) To UBound(NestedCrnt)
If VarType(NestedCrnt(Inx)) = vbObject Then
Set RetnValue(Inx) = NestedCrnt(Inx)
Else
RetnValue(Inx) = NestedCrnt(Inx)
End If
Next
End Sub