VBA试图执行生成的子当chrashes [英] VBA chrashes when trying to execute generated sub
问题描述
我知道我不应该这样做，但我不得不这样做。
我试图操纵VBA多维数组，在这种特殊情况下，我有一个字符串添加到一个多维数组，所有的，但有一个元素，如编曲最后一维（1至1，1比1，1〜3）
由于VBA不允许访问任意秩的数组的元素，我在运行时作为写子：
公用Sub AddItemToReducedArr（为ByRef编曲（）作为字符串，外形尺寸为字节，_
项目作为字符串
）
昏暗VBCOMP作为VBIDE.VBComponent
昏暗我作为整数
昏暗ArrElementS作为字符串
昏暗ArrElementR作为字符串
设置VBCOMP = ThisWorkbook.VBProject.VBComponents（modCustom code）
随着VBCOMP。codeModule
.DeleteLines 1，.CountOfLines
.InsertLines 1，_
公用Sub AddItemToReducedArr code（为ByRef编曲（）作为字符串，与＆amp; _
尺寸为字节，项目作为字符串）
ArrElementS = _
编曲（和替换（字符串（（尺寸 - 1），*），*，1，）及_
*（编曲，与＆amp;尺寸和放大器;））
.InsertLines 2Debug.Print进入子
.InsertLines 3，如果LBOUND（编曲，与＆amp;尺寸和放大器;）= UBound函数（编曲，与＆amp; _
尺寸和放大器; ）和＆放大器;替换（ArrElementS，*，UBound函数）及_
=，然后
.InsertLines 4，替换（ArrElementS，*，UBound函数）及=项目
.InsertLines 5，否则
ArrElementR = _
编曲（和替换（字符串（（尺寸 - 1），*），*，1到1）及_
LBOUND（编曲，与＆amp;尺寸和放大器;）要UBound函数（编曲，与＆amp;尺寸和放大器;）+ 1）
.InsertLines 6，REDIM preserve与＆amp; ArrElementR
.InsertLines 7，替换（ArrElementS，*，UBound函数）及=项目
.InsertLines 8日，结束如果
.InsertLines 9，终止子
Debug.Print创建子
我也想在这里补充睡眠，许多的DoEvents和保存，没有工作
AddItemToReducedArr code编曲，尺寸，项目
Debug.Print呼吁适当
结束与
设置VBCOMP =什么
复位code
结束小组
重置code 子程序只是清除创建的子里面的code和未列出的简洁性。
在这个阶段，VBA不允许通过code步进，很少执行的预期，大多不执行创建的子有时chrashes。
我可以从使用VBA这类任务做错了，分开？你觉得我都放弃了，等到我有其他的发展选择（很长一段时间，这将是）还是有我就是缺少了点？
您可以通过创建一个名为模块 modCustom code 键，使用下面的测试测试此code：
公用Sub testASDF（）
昏暗编曲（）作为字符串
使用ReDim编曲（1对1，1到2）
编曲（1,1）=一个
编曲（1，2）=b的
AddItemToReducedArr编曲，2，C
Debug.Print UBound函数（编曲，2）
Debug.Print编曲（1，UBound函数（编曲，2））
结束小组
另一种方法是使用变种。试想一下：
暗淡vdaA为Variant 使用ReDim vdaA（1到2）
vdaA（1）=阵列（1，2，3，4）
vdaA（2）=阵列（5，6，7，8，9，10）
Debug.Print vdaA（1）（0）及与＆amp; vdaA（1）（1）及与＆amp; vdaA（1）（2）及与＆amp; vdaA（1）（3）
Debug.Print vdaA（2）（0）及与＆amp; vdaA（2）（1）及与＆amp; vdaA（2）（2）及与＆amp; _
vdaA（2）（3）及与＆amp; vdaA（2）（4）及与＆amp; vdaA（2）（5）
从这个code的输出是：
1 2 3 4
5 6 7 8 9 10
我已经声明vdaA为Variant，然后使用 REDIM 将其转换为一维数组。如果你输入你会得到一个语法错误使用ReDim vdaA（1）（0〜3）。但是，你可以转换vdaA（1）和vdaA（2）成不同大小的数组，因为我已经证明。另外，您可以通过vdaA（1）子程序作为一个变量，使用ReDim 在那里。
我已经转换为vdaA交错数组。如果你搜索铁血阵你可以让他们更充分的描述，但我已经给你这个答案的目的，适当的介绍。
据我了解，你并不需要不同的行有不同的列数，但我相信你可以看到可用的灵活性。可以通过 vdaA（1）下降到一个子程序，它转换成一个数组。 vdaA（1）（1）然后可以传下来的转换。递归你可以声明与许多维度数组作为你确定要在运行时必要的。其他递归程序可以找到特定的条目，并设置或获取的值。
很多年前，我没有得到这种技术的工作虽然它伤害了我的大脑。我不再有code和我不会推荐它，除非没有别的能符合要求。然而，它可以使在必要时使用。
下code采用了多simplier技术。它只能处理规则排列并处理最多五个维度。 十一五是任意的，如果需要，code可以很容易地调整到一个更大的限制。
显示code之前，我想讨论的参数数组。我一直感到惊讶，在过去许多有经验的程序员VBA怎么见过不知道参数数组或者他们给你的灵活性。很抱歉，如果我侮辱你的知识。
一个可能的声明是：
子MySub（为ByRef一长，BYVAL b以字符串的ParamArray Z（）为Variant）
参数A和B是固定式的。我可能有固定的类型参数C，D，E等的需要。我的最后一个参数是一个参数数组，这意味着我可以按照A，B的值与许多参数需要我。以下是该程序的有效来电：
呼叫MySub（27，A，1，X）
调用MySub（54，B，1，X，2，Y）
调用MySub（54，B，1，X，2，Y，3，Z）
在这些例子中我有这些额外参数的模式。然而，VarType函数可以让我检查每个参数的类型，使他们不必遵循一个简单的模式。
我的一个例程有一个声明：
子VdaInit（VDA的ByRef为Variant，下界的ParamArray（）为Variant）
有效的呼叫包括：
呼叫VdaInit（vdaA，1，2）
调用VdaInit（vdaA，1,2，-1，4）
调用VdaInit（VDAB，1,2，-1，4，10，15）
调用VdaInit（vdaA，1,2，-1，4，10，15，5，6）
调用VdaInit（VDAB，1,2，-1，4，10，15，5，6，0，4）
这些等效于：
使用ReDim vdaA（1〜2）
使用ReDim vdaA（1至2，-1至4）
使用ReDim vdaA（1至2，-1至4，10〜15）
使用ReDim vdaA（1至2，-1至4,10至15，5至6）
使用ReDim vdaA（1至2，-1至4,10至15，5至6个，0到4）
其它电话是：
呼叫VdaStoreValue（vdaA，DateSerial（2014，1，7），2，4，15，5）
结果= VdaGetValue（VDAB，2，4，15，5,4）
这是等同于：
VDA（2，4，15，5）= DateSerial（2014，1，7）
结果= VDAB（2,4，15，5,4）
您只有前pressed在弦乐的兴趣但变种可以有任何类型没有额外的努力。
背后VdaGetValue的code，例如，是简单的：
DimMax = NumDim（VDA）
选择案例DimMax
情况1
VdaGetValue = VDA（指数（0））
案例2
VdaGetValue = VDA（指数（0），指数（1））
案例3
VdaGetValue = VDA（指数（0），指数（1），指数（2））
案例4
VdaGetValue = VDA（指数（0），指数（1），指数（2），指数（3））
案例5
VdaGetValue = VDA（指数（0），指数（1），指数（2），指数（3），指数（4））
结束选择
如果有必要
不优雅，但非常简单，可扩展到10或15的尺寸。
下code不包括参数的有效性验证，而不是全面测试。不过，我认为它提供了这种做法的充分论证。
显式的选项
子测试（） 昏暗vdaA为Variant
昏暗VDAB为Variant使用ReDim vdaA（1到2）
'vdaA（1）=阵列（1，2，3，4）
'vdaA（2）=阵列（5，6，7，8，9，10）
'Debug.Print vdaA（1）（0）及与＆amp; vdaA（1）（1）及与＆amp; vdaA（1）（2）及与＆amp; vdaA（1）（3）
'Debug.Print vdaA（2）（0）及与＆amp; vdaA（2）（1）及与＆amp; vdaA（2）（2）及与＆amp; _
'vdaA（2）（3）及与＆amp; vdaA（2）（4）及与＆amp; vdaA（2）（5） 调用VdaInit（vdaA，1，2）
Debug.PrintVdaA与＆amp; VdaBoundList（vdaA）
调用VdaInit（vdaA，1,2，-1，4）
Debug.PrintVdaA与＆amp; VdaBoundList（vdaA）
调用VdaInit（VDAB，1,2，-1，4，10，15）
Debug.PrintVDAB与＆amp; VdaBoundList（VDAB）
调用VdaInit（vdaA，1,2，-1，4，10，15，5，6）
Debug.PrintVdaA与＆amp; VdaBoundList（vdaA）
调用VdaInit（VDAB，1,2，-1，4，10，15，5，6，0，4）
Debug.PrintVDAB与＆amp; VdaBoundList（VDAB） 呼叫VdaStoreValue（vdaA，A，1，-1，10，5）
呼叫VdaStoreValue（vdaA，27，1，-1，10，6）
调用VdaStoreValue（vdaA，5.3，1，-1，11，5）
调用VdaStoreValue（vdaA，DateSerial（2014，1,7），2，4，15，5） 呼叫VdaStoreValue（VDAB，诚然，1，-1，10，5，0）
调用VdaStoreValue（VDAB，B，1，-1，10，5，1）
呼叫VdaStoreValue（VDAB，假，1，-1，10，5，2）
调用VdaStoreValue（VDAB，1234，2，4，15，5,4） Debug.PrintVdaA（1，-1，10，5）=与＆amp; VdaGetValue（vdaA，1，-1，10，5）
Debug.PrintVdaA（1，-1，10，6）=与＆amp; VdaGetValue（vdaA，1，-1，10，6）
Debug.PrintVdaA（1，-1，11，5）=与＆amp; VdaGetValue（vdaA，1，-1，11，5）
Debug.PrintVdaA（2,4，15，5）=与＆amp; VdaGetValue（vdaA，2，4，15，5） Debug.PrintVDAB（1，-1，10，5,0）=与＆amp; VdaGetValue（VDAB，1，-1，10，5,0）
Debug.PrintVDAB（1，-1，10，5,1）=与＆amp; VdaGetValue（VDAB，1，-1，10，5，1）
Debug.PrintVDAB（1，-1，10，5,2）=与＆amp; VdaGetValue（VDAB，1，-1，10，5,2）
Debug.PrintVDAB（2,4，15，5,4）=与＆amp; VdaGetValue（VDAB，2，4，15，5,4）结束小组
子VdaInit（VDA的ByRef为Variant，下界的ParamArray（）为Variant） 'VDA：变体将被转换成一个多维数组。
边界：一对或多对边界的尺寸。对的数目
'定义维数。对于每一对，所述第一值是
'下界和第二个是上限。 这个例程创建尺寸1，并调用VdaInitSub创建
进一步的尺寸 我使用Debug.Assert的，因为我的错误，只有程序员测试
应该看到。
Debug.Assert的UBound函数（边界）＆GT; = 1'至少需要一对界
Debug.Assert的UBound函数（边界）mod2 = 1需要偶数界
我不检查边界是有效的整数 选择案例UBound函数（边界）
情况1
使用ReDim VDA（界限（0）到bounds（1））
案例3
使用ReDim VDA（界限（0）到bounds（1），边界（2）边界（3））
案例5
使用ReDim VDA（界限（0）到bounds（1），边界（2）边界（3）_
边界（4）边界（5））
案例7
使用ReDim VDA（界限（0）到bounds（1），边界（2）边界（3）_
边界（4）边界（5），边界（6）界限（7））
案例9
使用ReDim VDA（界限（0）到bounds（1），边界（2）边界（3）_
边界（4）边界（5），边界（6）界限（7），_
边界（八）界（9））
结束选择结束小组
功能VdaBoundList（VDA BYVAL为Variant）作为字符串 'VDA：已经转化为多维阵列的变体。 返回格式的字符串：（L1至U1，L2至U3 ...）
'这给每个维度的dounds 昏暗DimCrnt只要
昏暗DimMax只要 DimMax = NumDim（VDA） VdaBoundList =（
对于DimCrnt = 1到DimMax
VdaBoundList = VdaBoundList＆安培; LBOUND（VDA，DimCrnt）及以与＆amp; UBound函数（VDA，DimCrnt）
如果DimCrnt＆LT; DimMax然后
VdaBoundList = VdaBoundList＆安培; ，
万一
下一个
VdaBoundList = VdaBoundList＆安培; ）结束功能
功能VdaGetValue（VDA的ByRef为Variant，指数的ParamArray（）为Variant）为Variant 'VDA：已经转化为多维阵列的变体。
指数的参数范围内VDA入门从中值得到的指数。
指数的数量必须VDA的维数相匹配。 '实施例：结果= VdaGetValue（XYZ，1，2，3）
'等同于结果= XYZ（1，2，3）
'提供XYZ具有三个维度和1，2和3是内
其尺寸的界限 昏暗DimCrnt只要
昏暗DimMax只要 DimMax = NumDim（VDA） Debug.Assert的UBound函数（指数）= DimMax - 1'错误的参数数量
对于DimCrnt = 1到DimMax
Debug.Assert的则IsNumeric（指数（DimCrnt - 1））指标必须是数字
''不在边界指数
'Debug.Assert的LBOUND（指数，DimCrnt - 1） - =指数（DimCrnt - 1）和_
'UBound函数（指数，DimCrnt - 1）＆GT =指数（DimCrnt - 1）
'下一个 选择案例DimMax
情况1
VdaGetValue = VDA（指数（0））
案例2
VdaGetValue = VDA（指数（0），指数（1））
案例3
VdaGetValue = VDA（指数（0），指数（1），指数（2））
案例4
VdaGetValue = VDA（指数（0），指数（1），指数（2），指数（3））
案例5
VdaGetValue = VDA（指数（0），指数（1），指数（2），指数（3），指数（4））
结束选择结束功能
子VdaStoreValue（VDA的ByRef为Variant，ParamArray参数ValAndIndices（）为Variant） 'VDA：已经转化为多维阵列的变体。
'ValAndIndices第一个参数是将被存储的值。由于这是一
Variant数组它可以是任何类型的。第二和后续
参数是条目的内VDA指数成
'的值是要被存储。指数的数量必须匹配
VDA的维号。 '实施例：VdaStoreValue（XYZ，实施例，1，2，3）
'等同于XYZ（1，2，3）=实施例
'提供XYZ具有三个维度和1，2和3是内
其尺寸的界限 昏暗DimCrnt只要
昏暗DimMax只要 DimMax = NumDim（VDA） Debug.Assert的UBound函数（ValAndIndices）= DimMax'的参数数目错误
我不检查的指标是数字和适当的范围内 选择案例DimMax
情况1
VDA（ValAndIndices（1））= ValAndIndices（0）
案例2
VDA（ValAndIndices（1），ValAndIndices（2））= ValAndIndices（0）
案例3
VDA（ValAndIndices（1），ValAndIndices（2），ValAndIndices（3））= ValAndIndices（0）
案例4
VDA（ValAndIndices（1），ValAndIndices（2），ValAndIndices（3），_
ValAndIndices（4））= ValAndIndices（0）
案例5
VDA（ValAndIndices（1），ValAndIndices（2），ValAndIndices（3），_
ValAndIndices（4），ValAndIndices（5））= ValAndIndices（0）
结束选择结束小组公共职能NumDim（的ParamArray TestArray（）为Variant）作为整数 返回TestArray的维数。 如果有确定的维数的官方途径，我找不到它。 '这例行测试维1，2，3，以此类推，直到它获得一个故障。
通过捕获，失败就可以确定最后的测试没有失败。 codeD 2010年6月加入文档2010年7月。 * TestArray（）是一个ParamArray，因为它允许任何类型的数组的传递。
'*被测试的数组不TestArray但TestArray（LBOUND（TestArray））。
*例行不验证TestArray（LBOUND（TestArray））是一个数组。如果
它不是一个数组，该程序返回0。
*例程不检查多个参数。如果调用
'NumDim（MyArray1，MyArray2），这将忽略MyArray2。 昏暗TestDim作为整数
昏暗的TestResult作为整数 对错误转到完成 TestDim = 1
做真时
的TestResult = LBOUND（TestArray（LBOUND（TestArray）），TestDim）
TestDim = TestDim + 1
循环完： NumDim = TestDim - 1结束功能
修改新建部分解释问题与参数数组，并给予可能的解决方案。
假如我有三个主要套路，舒伯和SUBB既苏巴和SUBB其命名为参数作为其唯一的参数，参数数组。进一步假设苏巴通过从主要接收到的SUBB参数数组。
在主要我有苏巴的呼叫：
呼叫舒伯（A，1，＃1/10/2014年＃，2.45）
有关苏巴，参数将有四个项目：
参数（0）=A
参数（1）= 1
参数（2）= 1/10/2014年＃，2.45
参数（3）= 2.45
如果苏巴然后调用SUBB：
呼叫SUBB（参数）
然后SUBB的参数将没有四项。相反，它会产生一个条目：
参数（0）=阵列（A，1，＃1/10/2014年＃，2.45）
我把这个嵌套。如果SUBB只能通过苏巴被称为subB的话可以codeD来处理嵌套参数数组。但是，如果SUBB也可以通过主调用，它变得有点凌乱。它得到梅塞尔还，如果您有SUBC并用的SubD参数数组，他们可以从任何父母被调用。
我用下面的程序转换参数数组和参数数组嵌套到任意深度一致的格式为：
子DeNestParamArray（RetnValue（）作为变，嵌套的ParamArray（）为Variant） codeD 2010年11月 每一个ParamArray传递到子程序时，它嵌套在一
'元素Variant数组。此程序发现嵌套的底层和
'设定RetnValue将值原始参数阵列中，使得其他常规
不必关心这种并发症。 昏暗NestedCrnt为Variant
昏暗量输入x作为整数 NestedCrnt =嵌套
查找嵌套的底层
做真时
如果VarType函数（NestedCrnt）LT; VBArray的再
有没有发现一个非数组元素等都必须达到最底层
Debug.Assert的假'。如果在previous水平已经退出循环
退出待办事项
万一
如果NumDim（NestedCrnt）= 1，则
如果LBOUND（NestedCrnt）= UBound函数（NestedCrnt）然后
这是一个元素的数组
如果VarType函数（NestedCrnt（LBOUND（NestedCrnt）））≤; VBArray的再
不过，这并不包含数组，以便用户只指定
'一个值;文字或非数组变量
这是这个循环的有效退出
退出待办事项
万一
NestedCrnt = NestedCrnt（LBOUND（NestedCrnt））
其他
这是一个一维的，非嵌套阵列
这是这个循环平时退出
退出待办事项
万一
其他
Debug.Assert的假这是一个数组，但没有一个一维阵列
退出待办事项
万一
循环 有没有发现底层数组。在返回数组保存的内容。
使用ReDim RetnValue（LBOUND（NestedCrnt）为UBound函数（NestedCrnt））
对于量输入x = LBOUND（NestedCrnt）为UBound函数（NestedCrnt）
如果VarType函数（NestedCrnt（量输入x））= vbObject然后
设置RetnValue（量输入x）= NestedCrnt（量输入x）
其他
RetnValue（量输入x）= NestedCrnt（量输入x）
万一
下一个结束小组
I know I shouldn't be doing this, but I have to.
I'm trying to manipulate multidimensional arrays in VBA, in this specific case, I have to add a string to a multidimensional array, with all but the last dimension having single elements like Arr(1 To 1, 1 To 1, 1 To 3)
As VBA does not allow accessing elements of an array of arbitrary rank, I write a sub at runtime as:
Public Sub AddItemToReducedArr(ByRef Arr() As String, Dimensions As Byte, _
Item As String
)
Dim VBComp As VBIDE.VBComponent
Dim i As Integer
Dim ArrElementS As String
Dim ArrElementR As String
Set VBComp = ThisWorkbook.VBProject.VBComponents("modCustomCode")
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
.InsertLines 1, _
"Public Sub AddItemToReducedArrCode(ByRef Arr() As String, " & _
"Dimensions As Byte, Item As String)"
ArrElementS = _
"Arr(" & Replace(String((Dimensions - 1), "*"), "*", "1, ") & _
"*(Arr, " & Dimensions & "))"
.InsertLines 2, "Debug.Print ""Enters Sub"""
.InsertLines 3, "If LBound(Arr, " & Dimensions & ") = UBound(Arr, " & _
Dimensions & ") And " & Replace(ArrElementS, "*", "UBound") & _
" = """" Then"
.InsertLines 4, Replace(ArrElementS, "*", "UBound") & " = Item"
.InsertLines 5, "Else"
ArrElementR = _
"Arr(" & Replace(String((Dimensions - 1), "*"), "*", "1 To 1, ") & _
"LBound(Arr, " & Dimensions & ") To UBound(Arr, " & Dimensions & ") + 1)"
.InsertLines 6, "Redim Preserve " & ArrElementR
.InsertLines 7, Replace(ArrElementS, "*", "UBound") & " = Item"
.InsertLines 8, "End If"
.InsertLines 9, "End Sub"
Debug.Print "creates sub"
'I also tried adding Sleep, many DoEvents here and saving, none worked
AddItemToReducedArrCode Arr, Dimensions, Item
Debug.Print "calls proper"
End With
Set VBComp = Nothing
ResetCode
End Sub
ResetCode Subroutine just clears the code inside the created sub and is not listed for simplicity.
At this stage, VBA does not allow stepping through the code, rarely executes as intended and mostly does not execute the created sub and sometimes chrashes.
What can I be doing wrong, apart from using VBA for this kind of task? Do you think I have to give up and wait until I have other development options (a long time that will be) or is there a point that I'm missing?
You can test this code by creating a module named modCustomCode and using the below test:
Public Sub testASDF()
Dim Arr() As String
ReDim Arr(1 To 1, 1 To 2)
Arr(1, 1) = "a"
Arr(1, 2) = "b"
AddItemToReducedArr Arr, 2, "c"
Debug.Print UBound(Arr, 2)
Debug.Print Arr(1, UBound(Arr, 2))
End Sub
An alternative approach is to use Variants. Consider:
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)
The output from this code is:
1 2 3 4
5 6 7 8 9 10
I have declared vdaA as a Variant and then used Redim to convert it to 1D array. You will get a syntax error if you type ReDim vdaA(1)(0 to 3). However, you can convert vdaA(1) and vdaA(2) into arrays of different sizes as I have shown. Alternatively you can pass vdaA(1) to a subroutine as a Variant and ReDim it there.
I have converted vdaA to a Jagged array. If you search for "Jagged array" you can get fuller descriptions of them but I have given you an adequate introduction for the purposes of this answer.
As I understand it, you do not need different rows to have different number of columns but I am sure you can see the flexibility that is available. You can pass vdaA(1) down to a sub-routine that converts it to an array. vdaA(1)(1) can then be passed down for conversion. With recursion you can declare arrays with as many dimensions as you determine to be necessary at run time. Other recursive routines can locate particular entries and set or get values.
Many years ago, I did get this technique to work although it hurt my brain. I no longer have that code and I would not recommend it unless nothing else could meet the requirement. However, it can be made to work if necessary.
The code below uses a much simplier technique. It only handles regular arrays and handles a maximum of five dimensions. "Five" is arbitrary and the code could easily be adjusted to a larger limit if necessary.
Before showing the code, I wish to discuss Param Arrays. I have been surprised in the past how many experienced VBA programmers seen unaware of Param Arrays or the flexibility they give you. Sorry if I am insulting your knowledge.
A possible declaration is:
Sub MySub(ByRef A As Long, ByVal B As String, ParamArray Z() As Variant)
Parameters A and B are of fixed type. I could have fixed type parameters C, D, E, and so on as is required. My last parameter is a Param Array which means I can follow the values for A and B with as many parameters as I require. The following are valid calls of this routine:
Call MySub(27, "A", 1, "X")
Call MySub(54, "B", 1, "X", 2, "Y")
Call MySub(54, "B", 1, "X", 2, "Y", 3, "Z")
In these examples I have a pattern to these extra parameters. However, VarType allows me to check the type of each parameter so they do not have to follow a simple pattern.
One of my routines has a declaration of:
Sub VdaInit(ByRef Vda As Variant, ParamArray Bounds() As Variant)
Valid calls include:
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)
These are equivalent to:
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)
Other calls are:
Call VdaStoreValue(vdaA, DateSerial(2014, 1, 7), 2, 4, 15, 5)
Result = VdaGetValue(VdaB, 2, 4, 15, 5, 4)
Which are equivalent to:
Vda(2, 4, 15, 5) = DateSerial(2014, 1, 7)
Result = VdaB(2, 4, 15, 5, 4)
You only expressed an interest in Strings but with Variants you can have any type for no extra effort.
The code behind VdaGetValue, for example, is simple:
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
Not elegant but very simple and extendable up to 10 or 15 dimensions if necessary.
The code below does not include much validation of parameters and is not fully tested. However, I think it provides an adequate demonstration of this approach.
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
Edit New section explaining a "problem" with Param Arrays and giving a possible solution.
Suppose I have three routines Main, SubA and SubB with both SubA and SubB having Param Arrays named "Param" as their only parameters. Suppose further that SubA passes the Param Array it receives from Main to SubB.
Within Main I have a call of SubA:
Call SubA("A", 1, #1/10/2014#, 2.45)
For SubA, Param will have four entries:
Param(0) = "A"
Param(1) = 1
Param(2) = #1/10/2014#, 2.45
Param(3) = 2.45
If SubA then calls SubB:
Call SubB(Param)
then SubB's Param will have not four entries. Instead it will have a single entry:
Param(0) = Array("A", 1, #1/10/2014#, 2.45)
I call this nesting. If SubB can only be called by SubA then SubB can be coded to handle a nested Param Array. However, if SubB can also be called by Main, it gets a little messy. It gets messer still if you have SubC and SubD with Param Arrays and they can be called from any of their parents.
I use the following routine to convert Param Arrays and Param Arrays nested to any depth to a consistent format:
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
这篇关于VBA试图执行生成的子当chrashes的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
