动态更改 nr。 VBA 数组的维度
Dynamicaly change the nr. of dimensions of a VBA array
我想知道是否有任何方法可以更改数组的维数:
- 在VBA、
- 取决于一个整数
max_dim_bound
表示
所需编号尺寸。
考虑到维度的起始索引:E.G. `array(4 to 5, 3 to 6) 其中3到6的个数是可变整数。
*代码本身没有额外的工具
- *不导出代码。
需要明确的是,以下更改不会更改数组维度的 nr,(仅是每个维度中元素的开始结束索引):
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
*否则解决方案是:
- 导出一个模块的全部代码,在维度这一行用准动态字符串
dimension_string
. 替换数组的静态维度
- 删除当前模块
- 在代码中导入带有准动态字符串
dimension_string
的新模块作为刷新的静态维度
然而,它看起来很复杂,我很好奇是否有人知道更简单的解决方案。
请注意,这不是以下内容的重复:Dynamically Dimensioning A VBA Array? Even though the question seems to mean what I am asking here, the intention of the question seems to be to change the nr. of elements in a dimension, not the nr. of dimensions. (The difference is discussed in this article by Microsoft。)
为了套用Uri Goren的回答,我分析了每一行,查了一下他们做了什么,并在背后评论了我的理解,以便提高或纠正我的理解。因为我不仅难以 运行 代码,而且难以理解这如何回答问题。此尝试包括以下步骤:
- 右击代码文件夹->插入->Class模块然后点击:
工具>选项>"marked:Require variable declaration"如图
here 在 00:59。
接下来我将class模块重命名为
接下来我在class模块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
然后我创建了一个新模块 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_array(3 到 4,5 到 9..)替换为存在的数组 in/as class 模块 FlexibleArray,即当它需要在模块中使用时被调用。但任何澄清将不胜感激! :)
听起来你是在滥用数组来做一些他们不应该做的大量内存复制。
你要的是自己写的Class
(右击代码文件夹->插入->Class模块),暂且叫FlexibleArray
.
您的 class 代码应该是这样的:
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 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
如果您在调试中查看它,您会注意到现在可以从返回数组的第一个索引访问重新定义的子数组
我想知道是否有任何方法可以更改数组的维数:
- 在VBA、
- 取决于一个整数
max_dim_bound
表示 所需编号尺寸。 考虑到维度的起始索引:E.G. `array(4 to 5, 3 to 6) 其中3到6的个数是可变整数。
*代码本身没有额外的工具
- *不导出代码。
需要明确的是,以下更改不会更改数组维度的 nr,(仅是每个维度中元素的开始结束索引):
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
*否则解决方案是:
- 导出一个模块的全部代码,在维度这一行用准动态字符串
dimension_string
. 替换数组的静态维度
- 删除当前模块
- 在代码中导入带有准动态字符串
dimension_string
的新模块作为刷新的静态维度
然而,它看起来很复杂,我很好奇是否有人知道更简单的解决方案。
请注意,这不是以下内容的重复:Dynamically Dimensioning A VBA Array? Even though the question seems to mean what I am asking here, the intention of the question seems to be to change the nr. of elements in a dimension, not the nr. of dimensions. (The difference is discussed in this article by Microsoft。)
为了套用Uri Goren的回答,我分析了每一行,查了一下他们做了什么,并在背后评论了我的理解,以便提高或纠正我的理解。因为我不仅难以 运行 代码,而且难以理解这如何回答问题。此尝试包括以下步骤:
- 右击代码文件夹->插入->Class模块然后点击: 工具>选项>"marked:Require variable declaration"如图 here 在 00:59。
接下来我将class模块重命名为
接下来我在class模块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
然后我创建了一个新模块 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_array(3 到 4,5 到 9..)替换为存在的数组 in/as class 模块 FlexibleArray,即当它需要在模块中使用时被调用。但任何澄清将不胜感激! :)
听起来你是在滥用数组来做一些他们不应该做的大量内存复制。
你要的是自己写的Class
(右击代码文件夹->插入->Class模块),暂且叫FlexibleArray
.
您的 class 代码应该是这样的:
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 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
如果您在调试中查看它,您会注意到现在可以从返回数组的第一个索引访问重新定义的子数组