动态更改VBA数组的维数

我想知道是否有任何方法可以更改数组的维数：

在VBA中

取决于整数

max\u dim\u bound

，该整数指示 所需的尺寸数

允许维度的起始索引：例如`数组（4到5，3到6），其中3到6的数字是可变整数

*在代码本身中没有额外的工具

*不导出代码

需要明确的是，以下更改不会更改数组维度的nr（仅更改每个维度中元素的起始-结束索引）：

以下示例将成功更改数组中的维度数：

my_arr(3 to 5, 6 to 10) 
'changed to:
my_arr(4 to 8, 2 to 7,42 to 29)

my_arr(4 to 8, 2 to 7,42 to 29)
'changed to:
my_arr(3 to 5, 6 to 10) 

这也是数组中维度数量的变化：

my_arr(3 to 5, 6 to 10) 
'changed to:
my_arr(4 to 8, 2 to 7,42 to 29)

my_arr(4 to 8, 2 to 7,42 to 29)
'changed to:
my_arr(3 to 5, 6 to 10) 

到目前为止，我的尝试包括：

Sub test_if_dynamically_can_set_dimensions()
    Dim changing_dimension() As Double
    Dim dimension_string_attempt_0 As String
    Dim dimension_string_attempt_1 As String
    Dim max_dim_bound As String
    Dim lower_element_boundary As Integer
    Dim upper_element_boundary As Integer

    upper_element_boundary = 2
    max_dim_bound = 4

    For dimen = 1 To max_dim_bound
        If dimen < max_dim_bound Then
            dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary & ","
            MsgBox (dimension_string_attempt_0)
        Else
            dimension_string_attempt_0 = dimension_string_attempt_0 & "1 To " & upper_element_boundary
        End If
    Next dimen
    MsgBox (dimension_string_attempt_0)
    'ReDim changing_dimension(dimension_string_attempt_0) 'does not work because the "To" as expected in the array dimension is not a string but reserved word that assists in the operation of setting an array's dimension(s)
    'ReDim changing_dimension(1 & "To" & 3, 1 To 3, 1 To 3) 'does not work because the word "To" that is expected here in the array dimension is not a string but a reserved word that assists the operation of setting an array's dimension(s).
    'ReDim changing_dimension(1 To 3, 1 To 3, 1 To 3, 1 To 3)

    'attempt 1:
    For dimen = 1 To max_dim_bound
        If dimen < max_dim_bound Then
            dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary & ","
            MsgBox (dimension_string_attempt_1)
        Else
            dimension_string_attempt_1 = dimension_string_attempt_1 & upper_element_boundary
        End If
    Next dimen
    MsgBox (dimension_string_attempt_1)
    ReDim changing_dimension(dimension_string_attempt_1) 'this does not change the nr of dimensions to 2, but just one dimension of "3" and "3" = "33" = 33 elements + the 0th element
    'changing_dimension(2, 1, 2, 1) = 4.5
    'MsgBox (changing_dimension(2, 1, 2, 1))
End Sub

然后我创建了一个新的模块11，并复制了下面的代码，包括试图让代码正常工作的修改

Option Explicit
Sub use_class_module()
Dim A As New FlexibleArray 'this dimensions object A but it is not set yet
A.Init (3) 'calls the public sub "Init" in class module FlexibleArray, and passes integer n = 3.
'A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray  function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
'A.SetByKey(2, "b") 'this means that Objecgt A. in class FlexibleArray function SetByKey sets the private string array vals(2) in class Flexible Array becomes "b"
'A.SetByKey(3, "c") 'this means that Object A. in class FlexibleArray function SetByKey sets the private string array vals(3) in class Flexible Array becomes "c"
'A.RenameKey(3,5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5

' Would print the char "c"

'to try to use the functions:
'A.SetByKey(1, "a") = 4
'MsgBox (keys("a"))
'test = A.SetByKey(1, "a") 'this means that Objecgt A. in class FlexibleArray  function SetByKey sets the private string array vals(1) in class Flexible Array becomes "a"
'MsgBox (test)
'test_rename = A.RenameKey(3, 5) 'This means that object A in class FlexibleArray keys element 3 becomes 5 so keys(3) = 5
'MsgBox (test_rename)
'Print A.GetByKey(5) 'Method not valid without suitable object


'current problem:
'the A.SetByKey expects a function or variable, even though it appears to be a function itself.

End Sub

---

我目前期望的是，这段代码将my_数组（3到4,5到9..）替换为类模块FlexibleArray中存在的数组，该数组在需要在模块中使用时被调用。但任何澄清都将不胜感激！：）

听起来你是在滥用数组，因为它们本不应该进行大量内存复制

您需要编写自己的

类

（右键单击代码文件夹->插入->类模块），我们称之为

FlexibleArray

您的类代码如下所示：

Private keys() as Integer
Private vals() as String
Private i as Integer

Public Sub Init(ByVal n as Integer)
   Redim keys(n)
   Redim vals(n)
   For i = 1 to n
        keys(i) = i
   Next i
End Sub

Public Function GetByKey(ByVal key As Integer) As String
   GetByKey = vals(Application.Match(key, keys, False))
End Function

Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
   vals(Application.Match(key, keys, False)) = val
End Sub

Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
   keys(Application.Match(oldName, keys, False))=newName
End Sub

现在，您可以重命名所需的任何密钥：

Dim A as New FlexibleArray
A.Init(3)
A.SetByKey(1, "a")
A.SetByKey(2, "b")
A.SetByKey(3, "c")
A.RenameKey(3,5)
Print A.GetByKey(5)
' Would print the char "c"

---

将其扩展到整数范围（如您的示例）非常简单

如果重新确定数组大小的目标仅限于非荒谬的级别数，那么一个简单的函数可能适合您，比如1到4维

您可以传递一个表示每个维度的上下限的字符串，并传回重新标注维度的数组

Public Function FlexibleArray(strDimensions As String) As Variant

    ' strDimensions = numeric dimensions of new array
    ' eg. "1,5,3,6,2,10" creates ARRAY(1 To 5, 3 To 6, 2 To 10)

    Dim arr()               As Variant
    Dim varDim              As Variant
    Dim intDim              As Integer

    varDim = Split(strDimensions, ",")
    intDim = (UBound(varDim) + 1) / 2

    Select Case intDim
        Case 1
            ReDim arr(varDim(0) To varDim(1))
        Case 2
            ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3))
        Case 3
            ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5))
        Case 4
            ReDim arr(varDim(0) To varDim(1), varDim(2) To varDim(3), varDim(4) To varDim(5), varDim(6) To varDim(7))
    End Select

    ' Return re-dimensioned array
    FlexibleArray = arr
End Function

通过使用数组边界调用它来测试它

Public Sub redimarray()
    Dim NewArray() As Variant

    NewArray = FlexibleArray("1,2,3,8,2,9")
End Sub

在调试模式下返回的数组应与此类似

编辑-添加了变体数组的真正动态数组示例

Public Sub redimarray()
    Dim NewArray() As Variant

    NewArray = FlexibleArray("1,2,3,8,2,9")
End Sub

下面是一个获得真正灵活的重定尺寸数组的方法示例，但我不确定这是否是您想要的，因为第一个索引用于访问其他数组元素

Public Function FlexArray(strDimensions As String) As Variant

    Dim arrTemp     As Variant
    Dim varTemp     As Variant

    Dim varDim      As Variant
    Dim intNumDim   As Integer

    Dim iDim        As Integer
    Dim iArr        As Integer

    varDim = Split(strDimensions, ",")
    intNumDim = (UBound(varDim) + 1) / 2

    ' Setup redimensioned source array
    ReDim arrTemp(intNumDim)

    iArr = 0
    For iDim = LBound(varDim) To UBound(varDim) Step 2

        ReDim varTemp(varDim(iDim) To varDim(iDim + 1))
        arrTemp(iArr) = varTemp
        iArr = iArr + 1
    Next iDim

    FlexArray = arrTemp
End Function

如果您在Debug中查看它，您会注意到现在可以从返回数组的第一个索引中访问重新定尺寸的子数组

---

在x到y中，To不是字符串，而是一个保留字，用于帮助设置数组的维度。将其置于引号中就像试图使用

单元格（1，1）。“复制”

；这根本不正确。谢谢你的解释，我很难用语言表达出来。我对代码进行了修改，以纳入您对几次尝试均无效的原因的评论。您能否给出更多您尝试执行的示例？您是否有一个数组被标注为，例如，

myArr（4到5，3到6）

，您希望将其重新标注为，例如，

myArr（4到6，3到7）

。。。这是一个有代表性的例子吗？在我的答案中添加了一个例子，为您提供了一个真正灵活的重新标注尺寸的数组-但是您必须从第一个索引访问子元素。它是一个数组数组。可能必须更改访问重拨阵列的代码，但它应该适合您？？？哇，这是一种非常有创意的方法！这并不是我在提出问题时所想的那种形式的确切的常规解决方案，但它再次有效地实现了目标，只需稍微重写我访问不同维度阵列的方式。这一次，在没有

max\u dim\u bound

的前提下。它提醒我们要跳出思维定势。非常感谢你的坚持，我接受了你的回答！非常感谢@Uri Goren！我发现要实现你的答案很有挑战性，而且我更难理解它如何适用于这个问题。所以我道歉，但这对我来说不是直截了当的。为了试图理解你的答案，我调查了你的每一行代码，并用我目前的理解对其进行了评论。我将研究您的解决方案，并通过使用类模块函数进行更多练习，以尝试使您的解决方案正常工作。谢谢@dbmitch！它确实有效地解决了我试图做的事情，但从技术上讲，它不能保证在编写代码之前不知道

max\u dim\u bound

有多大的情况下完全回答这个问题。我很感激你写下的答案是如此清晰和明确，我希望这将是我们将得到的最接近的结果。所以我会等到周日晚上，如果没有一个解决方案不需要事先了解

max\u dim\u bound

，并且考虑到荒谬的维度，我会接受你的答案！谢谢你的努力！感谢您的反馈。是的，您应该在函数中添加一个

max dim bound

常量，如果

intDim

超过该值，则返回适当的错误消息。