vba - 动态改变编号VBA 数组的维数

Question

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

1. 在 VBA 中，
2. 取决于一个整数max_dim_bound，它指示 所需编号尺寸。

3. 允许维度的起始索引:E.G. `array(4 到 5, 3 到 6)，其中 3 到 6 的数量是可变整数。

4. *在代码本身中，无需额外工具

5. *不导出代码。

需要明确的是，以下更改不会更改数组的维度数(仅更改每个维度中元素的起始结束索引):

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

以下示例是 nr 的成功更改。数组中的维度:

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

这也将是 nr 的变化。数组中的维度:

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

*否则解决方案是:

1. 导出模块的整个代码，并在维度行用准动态字符串 dimension_string 替换数组的静态重新维度。
2. 删除当前模块
3. 使用准动态字符串 dimension_string 导入新模块，作为代码中刷新的静态重新尺寸。

但是，这似乎很复杂，我很好奇是否有人知道更简单的解决方案。

请注意，这不是以下内容的重复项: Dynamically Dimensioning A VBA Array?尽管这个问题似乎意味着我在这里问的意思，但这个问题的意图似乎是改变nr。维度中元素的数量，而不是 nr。维度。 (this article by Microsoft 中讨论了差异。)

---

为了尝试应用 Uri Goren 的答案，我分析了每一行并查找了他们做了什么，并评论了我对其背后的理解，以便我的理解可以得到改进或纠正。因为我不仅难以运行代码，而且难以理解它如何回答问题。这次尝试包括以下步骤:

1. 右键单击代码文件夹 -> 插入 -> 类模块 然后单击: 工具>选项>“标记:需要变量声明”如图所示 here 00:59。

2. 接下来我将类模块重命名为

3. 接下来我在类模块FlexibleArray中编写了以下代码:

   Option Explicit
   Dim A As New FlexibleArray
   Private keys() As Integer
   Private vals() As String
   Private i As Integer
   
   Public Sub Init(ByVal n As Integer)
      ReDim keys(n) 'changes the starting element index of array keys to 0 and index of last element to n
      ReDim vals(n) 'changes the starting element index of array keys to 0 and index of last element to n
      For i = 1 To n
           keys(i) = i 'fills the array keys as with integers from 1 to n
      Next i
   End Sub
   
   Public Function GetByKey(ByVal key As Integer) As String
      GetByKey = vals(Application.Match(key, keys, False))
      ' Application.Match("what you want to find as variant", "where you can find it as variant", defines the combination of match type required and accompanying output)
       'Source: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheetfunction-match-method-excel
       ' If match_type is 1, MATCH finds the largest value that is less than or equal to lookup_value. Lookup_array must be placed in ascending order: ...-2, -1, 0, 1, 2, ..., A-Z, FALSE, TRUE.
       ' If match_type is 0, MATCH finds the first value that is exactly equal to lookup_value. Lookup_array can be in any order.
       ' If match_type is -1, MATCH finds the smallest value that is greater than or equal to lookup_value. Lookup_array must be placed in descending order: TRUE, FALSE, Z-A, ...2, 1, 0, -1, -2, ..., and so on.
   
       'so with False as 3rd optional argument "-1" it finds the smallest value greater than or equal to the lookup variant, meaning:
       'the lowest value of keys that equals or is greater than key is entered into vals,
       'with keys as an array of 1 to n, it will return key, if n >= key. (if keys is initialized right before getbykey is called and is not changed inbetween.
   
      'vals becomes the number inside a string. So vals becomes the number key if key >= n.
   
   End Function
   
   Public Sub SetByKey(ByVal key As Integer, ByVal val As String)
      vals(Application.Match(key, keys, False)) = val
      'here string array vals(element index: key) becomes string val if key >=n (meaning if the element exists)
   
   
   End Sub
   
   Public Sub RenameKey(ByVal oldName As Integer, ByVal newName As Integer)
      keys(Application.Match(oldName, keys, False)) = newName
       'here keys element oldname becomes new name if it exists in keys.
   End Sub
   

4. 然后我创建了一个新的 module11 并将以下代码复制到其中，包括进行修改以尝试使代码正常工作。

   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_array(3 到 4,5 到 9..) 替换为存在于/作为类模块FlexibleArray 中的数组，该数组在需要在模块中使用时被调用。但任何澄清将不胜感激! :)

Answer 1

如果重新调整数组尺寸的目标仅限于一定数量的级别，那么一个简单的函数可能适合您，例如 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

应该返回一个在 Debug模式下看起来像这样的数组

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

这是获得真正灵活的重新调整数组大小的方法的示例，但我不确定这是否是您正在寻找的，因为第一个索引用于访问其他数组元素。

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

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