我正在寻找使用来自另一个数组的坐标来访问数组的方法，就像这样。对于这种情况，我无法事先知道数据数组中的维数，因此不能真正在函数中使用不确定数量的可选变量。
Dim myArray(1 To 4, 1 To 2) As String
Dim myCoord(1 To 2) As Long
myArray(1, 1) = "one_one"
myArray(1, 2) = "one_two"
...
myArray(4, 2) = "four_two"
myCoord(1) = 3
myCoord(2) = 1
MsgBox(myArray(myCoord))
因此，我正在寻找类似于上述消息框的内容，该消息框能够显示“ three_one”。就像在python的my_multidim_list[*[i, j, ..., n]]中一样，不知道在VBA中是否完全有可能，但是对我来说，实现这种可能性似乎并不合逻辑。
答案 0 :(得分：1)
这是我最初的答案，它提供了有关VBA阵列的一些背景知识。我将对其进行扩展，以提供足够的背景来理解我的第二个答案。
简单的答案是：
Dim myArray(1 To 4, 1 To 2) As String
Dim myCoord(1 To 2) As Long
myArray(1, 1) = "one_one"
myArray(1, 2) = "one_two"
...
myArray(4, 2) = "four_two"
myCoord(1) = 3
myCoord(2) = 1
MsgBox(myArray(myCoord(1), myCoord(2))) ' This is the only change
这基于myCoord的每个元素，这些元素定义了myArray相应维度的元素编号。
有关数组的其他信息
在编写Dim myArray(1 To 4, 1 To 2) As String时，维数和每个维中的元素数是固定的，直到用不同的数字重写此语句为止。
如果您编写Dim myArray() As String，则是在声明数组，但是维数及其边界将在运行时定义。
在您的代码中，您可以编写ReDim myArray(a To b, c To d, e To f)，其中a到f是整数表达式。在我所知道的大多数语言中，下限由该语言定义为0或1。对于VBA，只要下限不超过上限，则下限可以是任何值。我只有一次找到了用于负下限的用途，但该选项在那里。
稍后您可以编写ReDim myArray(g To h)，但是您将丢失myArray中的所有数据。
或者，您可以编写ReDim Preserve myArray(a To b, c To d, e To g)。请注意，a到e不变。使用ReDim Preserve只能更改最后一个尺寸的上限。 ReDim Preserve创建一个新的更大（或更小）的数组，从旧数组中复制数据，并将新元素初始化为数据类型的默认值。过度使用ReDim Preserve可能会使您的宏运行缓慢，因为解释器的内存不足，但是如果谨慎使用，它会非常有用。
我可能会定义myCoords的维数与myArray相同，但这取决于您的目标。
关于VBA阵列，我还有很多话要说。如果您扩大自己的目标，我会添加适当的额外信息。
答案 1 :(得分：0)
我的答案超出了Stackoverflow的30,000个字符的限制，因此我将其分成了几个部分。这是第1部分。
尽管您没有回答有关如何填充数组的问题，但我认为只有一个可行的方法可以作为类实现。
如果您几个月前曾问过我有关VBA的课程，那我会不屑一顾。我的观点是，如果您的要求足够复杂以至需要上一堂课，则VBA不是合适的语言。我并未完全改变主意，但最近发现了一个VBA StringBuilder类，该类非常方便。以此经验为基础，我决定创建一个类来满足您的要求，这向我展示了一个类如何轻松地向用户隐藏复杂的处理。
我已将我的班级命名为MultDimStrArray。如果您不喜欢此名称，请将其更改为您喜欢的名称。如果您尝试使用我的测试宏，则将在其整个模块中更改名称。
我的课没有公共属性。它有四个公共方法：Initialise，PutElements，GetElements和OutDiag。
Initalise记录尺寸的数量和范围。示例调用为：
Dim MyArray1 As New MultDimStrArray
Call MyArray1.Initialise("3 to 10", "2")
和
Dim MyArray2 As MultDimStrArray
Dim Bounds1 As Variant
Bounds1 = Array( ("3 to 10", "2")
Call MyArray1.Initialise(Bounds1)
也就是说，您可以使用以下方法创建多维字符串数组：
Dim MyArray1 As New MultDimStrArray
或
Dim MyArray2 As MultDimStrArray
Set MyArray2 = New MultDimStrArray
第一种方法更受欢迎，但显然第二种方法更有效。
您可以在Initialise的调用中或在预定义的数组中记录尺寸范围。我已经使用函数Array来加载数组。如果愿意，可以以常规方式加载数组。宏Test1
一旦MDS数组已初始化，就可以使用PutElements在其中放置值。呼叫的格式为：
Call MyArray.PutElements(Start, Values)
Start是一个数组，在MyArray中每个维度具有一个元素；它标识MyArray中的元素。值可以是单个变量，也可以是任何类型的数组，只要其元素可以转换为字符串即可。如果“值”是单个变量或长度为1的数组，则其内容将复制到“开始”标识的元素中。如果Values是长度大于1的数组，则其内容将从Start开始复制到MyArray。调用PutElements可以在MyArray中放置一个值，也可以填充整个数组或两者之间的任何内容。宏Test2显示了可以使用PutElements的多种方式。
GetElements用于从MyArray中提取一个或多个值。调用的格式与PutElement相同，参数相同。只是复制方向不同。
最终方法是OutDiag，它没有参数。它将MyArray的全部详细信息输出到立即窗口。立即窗口最多可容纳200行。我考虑了输出到文本文件。如果您需要此例程，并且有大量数据，我可以对其进行修改以进行文件输出。
我已经测试了这些方法，但是还没有穷尽。我相信我创造了满足您需求的产品。但是，我不希望在确认它满足您的需求之前花更多的时间对其进行测试，特别是因为您的真实数据可能与我创建的任何数据都存在显着差异。
除了查看每种方法顶部的使用方法文档外，不要查看该类。尝试使用宏Test1，Test2和Test3。调整它们以更好地满足您的要求。尝试一些真实的数据。我将原始答案留在了该答案的结尾，但是您将需要更多有关VBA阵列的背景知识，以了解该类中的代码。我将扩展我的原始答案作为下一个任务。
此代码块是类。必须将其放置在名为MultDimStrArray的类模块中。我已经保留了诊断代码，但大部分都已注释掉。如果遇到错误，请报告给我，因为我认为您不具备自己调试类的知识。
Option Explicit
' Members
Private MDSArray() As String ' The MD array is held as a 1D array
' Elements are held in the sequence:
' 1D 2D 3D 4D ... nD
' lb lb lb lb lb to ub
' lb lb lb lb+1 lb to ub
' lb lb lb lb+2 lb to ub
' : : : : :
' lb lb lb ub lb to ub
' lb lb lb+1 lb lb to ub
' : : : : :
' ub ub ub ub lb to ub
' Note: each dimension has its own lower and upper bound
Private DimMax As Long ' Number of dimensions
Private DimOffs() As Long ' Offset from element to equivalent element in next
' repeat for each dimension.
' For dimension 1, this is offset from (a,b,c,d) to (a+1,b,c,d).
' For dimension 2, this is offset from (a,b,c,d) to (a,b+1,c,d).
' And so on.
' Used to convert (a,b,c,d) to index into MDSArray.
Private InxMax As Long ' The total number of elements in the MDS array
Private LBounds() As Long ' Lower bound of each dimension
Private UBounds() As Long ' Upper bound of each dimension
' Methods
Public Sub Class_Initialize()
' Will be called by interpreter when it wishes to initialise an instance of
' MultDimStrArray. Setting NumDim = 0 indicates that the instance has not
' be initialised by the class.
DimMax = 0
End Sub
Public Sub GetElements(ParamArray Params() As Variant)
' Extracts one or more strings starting at a specified element from
' the multi-dimensional string array.
' This sub has two compulsory parameters. The declaration uses a ParamArray
' to allow maximum flexibility in the type of those parameters. Effectively,
' this sub has a declaration of:
' GetElements(ByRef Start() As xxxx, ByRef Values() as yyyy) or
' GetElements(ByRef Start() As xxxx, ByVal Values as yyyy) or
' where xxxx can be any of the integer types plus Variant or String.
' and yyyy can be any type that can be accept a string.
' Start is a one-dimensional array with DimMax, integer elements. If the
' type of the array is Variant or String, the element values must be integer
' or an integer held as a string. The bounds of the array are not important.
' A lower bound of one to match dimension one may be convenient but a lower
' bound of zero or some other value may be used if wished.
' If the MDS array has N dimensions, Start must contain N values each of
' which must be within the bounds for the corresponding dimension. Together,
' the values within Start specify an element with the MDS array.
' Values can be a String or Varient variable or a one-dimensional String or
' Varient array. If the values within the MDS array are known to be
' integer, real or Boolean, then other types. However, if a value within
' the MDS array is not as expected, a call of GetElements may result in a
' fatal, VBA error.
' If Values is a variable or an array with a length of one, the value of
' element Start of the MDS array will be copied to Values.
' If Values is an array with a length greater than one, values will be
' copied to it from the MDS array starting from element Start. If possible,
' array Values will be filled; however, if there are insufficient elements
' in the MDS array, the remaining elements of Values will be left unchanged.
'Debug.Print "GetElements"
If DimMax = 0 Then
Debug.Assert False 'Not initialised
Exit Sub
End If
Dim InxA As Long
Dim InxS As Long
Dim InxV As Long
Dim LB As Long
Dim Start() As Long
Dim UB As Long
LB = LBound(Params)
UB = UBound(Params)
If LB + 1 <> UB Then
Debug.Assert False ' There must be exactly two parameters
Exit Sub
End If
If VarType(Params(LB)) < vbArray Then
Debug.Assert False ' First parameter (Start) must be an array
Exit Sub
End If
' Params(Params(LB)) contains values for Start.
InxS = 1
If UBound(Params(LB)) - LBound(Params(LB)) + 1 <> DimMax Then
Debug.Assert False ' Start must have one entry per dimension
Exit Sub
End If
ReDim Start(1 To DimMax)
For InxV = LBound(Params(LB)) To UBound(Params(LB))
' An error here indicates a value that cannot be converted to a Long
Start(InxS) = Params(LB)(InxV)
If Start(InxS) < LBounds(InxS) Or Start(InxS) > UBounds(InxS) Then
Debug.Assert False ' Index is outside range for dimension
Exit Sub
End If
InxS = InxS + 1
Next
InxA = 1
For InxS = 1 To DimMax
InxA = InxA + (Start(InxS) - LBounds(InxS)) * DimOffs(InxS)
Next
'' Report conversion from coordinates to InxA
'Debug.Print "(";
'For InxS = 1 To DimMax - 1
' Debug.Print Start(InxS) & ", ";
'Next
'Debug.Print Start(DimMax) & ") -> " & InxA
If VarType(Params(UB)) < vbArray Then
' Single value to be extracted from element defined by Start
'Debug.Assert False
' An error here indicates Params(UB) cannot hold the value in the MDS array
Params(UB) = MDSArray(InxA)
Else
' Array of values to be extracted starting at element defined by Start
'Debug.Assert False
'Debug.Print "Params(UB) Bounds: " & LBound(Params(UB)) & " To " & UBound(Params(UB))
For InxV = LBound(Params(UB)) To UBound(Params(UB))
Params(UB)(InxV) = MDSArray(InxA)
'Debug.Print "(" & InxA & ") contains " & Params(UB)(InxV)
InxA = InxA + 1
If InxA > InxMax Then
' Have reached end of MDSArray
Exit For
End If
Next
End If
End Sub
Public Sub Initialise(ParamArray Params() As Variant)
' Initalises an instance of the class by:
' Setting DimMax to number of dimensions
' Recording lower and upper bounds in LBounds and UBounds
' Calculating length of each dimension and recording them in DimOffs
' Calculating total number of entries in array and recording in InxMax
' ReDimming MDSarray to the required length
' The format of the call is: Xxxx.Initialise(parameters)
' Xxxx must be an object of type MultDimStrArray which must have been
' defined in one of these two ways:
' (1) Dim Xxxx As New MultDimStrArray
' (2) Dim Xxxx As MultDimStrArray
' Set Xxxx = New MultDimStrArray
' Most people use method 1 although method 2 results in more efficient code
' according to Charles H Pearson. http://www.cpearson.com/excel/classes.aspx
' In all cases, the parameters are a list of bounds. Those bounds can be
' specified as a list in the Initialise call or can be preloaded into an
' array.
' If the bounds are specified within the call, its format will be something like:
' Call Xxxx.Initialise(BoundsForDim1, BoundsForDim2, BoundsForDim3, ...)
' If the bounds are specified in a preloaded array, its format will be something like:
' Bounds = Array(BoundsForDim1, BoundsForDim2, BoundsForDim3, ...)
' Call Xxxx.Initialise(Bounds)
' or
' Bounds(1) = BoundsForDim1
' Bounds(2) = BoundsForDim2
' Bounds(3) = BoundsForDim3
' : : : :
' Call Xxxx.Initialise(Bounds)
' BoundsForDimN can be
' lb " to " ub
' or
' ub
' Each dimension will have its own lower bound (lb) and upper bound (ub).
' If the lb is not specified, it will default to 1. So 'ub' is equivalent to
' '1 To ub'
'Debug.Print "Initalise"
Dim Bounds() As String
Dim BoundParts() As String
Dim InxB As Long
Dim InxP As Long
Dim LB As Long
Dim NumElmnts As Long
' Convert different formats for Params to a single format
LB = LBound(Params)
If LB = UBound(Params) Then
' Single parameter.
'Debug.Assert False
If VarType(Params(LB)) > vbArray Then
' Params(LB) is an array. Call was of the form: .Initialise(Array)
' Copy contents of Array to Bounds
'Debug.Assert False
DimMax = UBound(Params(LB)) - LBound(Params(LB)) + 1
ReDim Bounds(1 To DimMax)
InxB = 1
For InxP = LBound(Params(LB)) To UBound(Params(LB))
' If get error here, element InxP of Array could not be converted to a string
Bounds(InxB) = Params(LB)(InxP)
InxB = InxB + 1
Next
Else
' Params(LB) is not an array. Call was of the form: .Initialise(X)
' where X is "N to M" or "M". Using this class for a 1D array would
' be inefficient but the code would work so it is not forbidden.
'Debug.Assert False
DimMax = 1
ReDim Bounds(1 To 1)
' If get error here, X could not be converted to a string
Bounds(1) = Params(LB)
End If
Else
' Multiple parameters. Call was of the form: .Initialise(X, Y, Z ...)
' where X, Y, Z and so on can be "N to M" or "M".
' Copy X, Y, Z and so to Bounds
'Debug.Assert False
DimMax = UBound(Params) - LBound(Params) + 1
ReDim Bounds(1 To DimMax)
InxB = 1
For InxP = LBound(Params) To UBound(Params)
' If get error here, one of X, Y, Z and so could not be
' converted to a string
Bounds(InxB) = Params(InxP)
InxB = InxB + 1
Next
End If
'Debug.Print "Bounds in call: ";
'For InxB = 1 To UBound(Bounds)
' Debug.Print Bounds(InxB) & " ";
'Next
'Debug.Print
' Decode values in Bounds and store in in LBounds and UBounds
ReDim LBounds(1 To DimMax)
ReDim UBounds(1 To DimMax)
ReDim DimOffs(1 To DimMax)
InxMax = 1
For InxB = 1 To UBound(Bounds)
' Value can be "lb To Ub" or "Ub"
If IsNumeric(Bounds(InxB)) Then
' Upper bound only
'Debug.Assert False
If Int(Bounds(InxB)) = Val(Bounds(InxB)) Then
' Integer value
'Debug.Assert False
LBounds(InxB) = 1
UBounds(InxB) = Bounds(InxB)
Else
Debug.Print "Invalid parameter: " & Bounds(InxB)
Debug.Assert False ' Real ub; only integer indices allowed
DimMax = 0 ' Not initialised
Exit Sub
End If
Else
' lb To ub
BoundParts = Split(LCase(Bounds(InxB)), " to ")
LB = LBound(BoundParts)
If LB + 1 <> UBound(BoundParts) Then
Debug.Print "Invalid parameter: " & Bounds(InxB)
Debug.Assert False ' Not "ub" and not "lb to ub"
DimMax = 0 ' Not initialised
Exit Sub
Else
If IsNumeric(BoundParts(LB)) And _
IsNumeric(BoundParts(LB + 1)) Then
If Int(BoundParts(LB)) = Val(BoundParts(LB)) And _
Int(BoundParts(LB + 1)) = Val(BoundParts(LB + 1)) Then
'Debug.Assert False
LBounds(InxB) = BoundParts(LB)
UBounds(InxB) = BoundParts(LB + 1)
Else
Debug.Print "Invalid parameter: " & Bounds(InxB)
Debug.Assert False ' lb or ub or both are real; indices must be integer
DimMax = 0 ' Not initialised
Exit Sub
End If
Else
Debug.Print "Invalid parameter: " & Bounds(InxB)
Debug.Assert False ' One or both of lb and ub are non-numeric or missing
DimMax = 0 ' Not initialised
Exit Sub
End If
End If
End If
If LBounds(InxB) > UBounds(InxB) Then
Debug.Print "Invalid parameter: " & Bounds(InxB)
Debug.Assert False ' lb must be less than ub
DimMax = 0 ' Not initialised
Exit Sub
End If
Next InxB
' Calculate offset to equivalent element in next repeat for each dimension.
DimOffs(DimMax) = 1
NumElmnts = (UBounds(DimMax) - LBounds(DimMax) + 1)
For InxB = DimMax - 1 To 1 Step -1
DimOffs(InxB) = NumElmnts * DimOffs(InxB + 1)
NumElmnts = (UBounds(InxB) - LBounds(InxB) + 1) ' Need for next loop
Next
InxMax = NumElmnts * DimOffs(1)
ReDim MDSArray(1 To InxMax)
End Sub
Public Sub OutDiag()
Dim ColWidthCrnt As Long
Dim ColWidthTotalLastDim As Long
Dim ColWidthsLast() As Long
Dim ColWidthsNotLast() As Long
Dim Coords() As Long
Dim InxA As Long ' Index into MDSArray
Dim InxC As Long ' Index into Coords
Dim InxD As Long ' Index into dimensions
'Dim InxL As Long ' Index into Last dimension
Dim InxWL As Long ' Index into ColWidthsLast
'Debug.Print "OutDiag"
If DimMax = 0 Then
Debug.Assert False 'Not initialised
Exit Sub
End If
Debug.Print "DimMax=" & DimMax
For InxD = 1 To DimMax
Debug.Print "Dim" & InxD & " Bounds=" & LBounds(InxD) & " to " & _
UBounds(InxD) & " Offset to next repeat=" & DimOffs(InxD)
Next
Debug.Print "InxMax=" & InxMax
Debug.Print
ReDim ColWidthsNotLast(1 To DimMax - 1)
ReDim ColWidthsLast(LBounds(DimMax) To UBounds(DimMax))
' Ensure columns for all but last wide enough for headings and coordinates
For InxD = 1 To DimMax - 1
ColWidthsNotLast(InxD) = Len("D" & CStr(InxD))
'Debug.Print "ColWidthsNotLast(" & InxD & ") initialsed to " & _
' ColWidthsNotLast(InxD) & " because of header ""D" & _
' CStr(InxD) & """"
ColWidthCrnt = Len(CStr(LBounds(InxD)))
If ColWidthsNotLast(InxD) < ColWidthCrnt Then
Debug.Assert False
ColWidthsNotLast(InxD) = ColWidthCrnt
'Debug.Print "ColWidthsNotLast(" & InxD & ") increased to " & _
' ColWidthsNotLast(InxD) & " because of lower bound """ & _
' CStr(LBounds(InxD)) & """"
End If
ColWidthCrnt = Len(CStr(UBounds(InxD)))
If ColWidthsNotLast(InxD) < ColWidthCrnt Then
Debug.Assert False
ColWidthsNotLast(InxD) = ColWidthCrnt
'Debug.Print "ColWidthsNotLast(" & InxD & ") increased to " & _
' ColWidthsNotLast(InxD) & " because of upper bound """ & _
' CStr(UBounds(InxD)) & """"
End If
Next
' Ensure columns for last dimension wide enough for headings
For InxWL = LBounds(DimMax) To UBounds(DimMax)
ColWidthsLast(InxWL) = Len(CStr(InxD))
'Debug.Print "ColWidthsLast(" & InxWL & ") initialised to " & _
' ColWidthsLast(InxWL) & " because of index """ & CStr(InxWL) & """"
Next
' Ensure columns for last dimension wide enough for values
ReDim Coords(1 To DimMax)
' Initialise Coords to indices for first entry in MDS array
For InxC = 1 To DimMax
Coords(InxC) = LBounds(InxC)
Next
'' Output co-ordinates to show which elements caused increase in width
'Debug.Print "(";
'For InxD = 1 To DimMax - 1
' Debug.Print Coords(InxD) & ", ";
'Next
'Debug.Print Coords(DimMax) & ") ";
InxA = 1
' Check length of each value against length of each column for last dimension
' Increase length of column for last dimension if necessary
Do While True
' Length for entry corrsponding specified by Coords
ColWidthCrnt = Len(MDSArray(InxA))
' Column for current index into last dimension
InxWL = Coords(DimMax)
' Increase column width if necessary
If ColWidthsLast(InxWL) < ColWidthCrnt Then
'Debug.Assert False
ColWidthsLast(InxWL) = ColWidthCrnt
'' Report reason for increased column width
'Debug.Print "ColWidthsLast(" & InxWL & ") increased to " & _
' ColWidthsLast(InxWL) & " because of value """ & _
' MDSArray(InxA) & """"
End If
' Step Coords to next entry
For InxD = DimMax To 1 Step -1
If Coords(InxD) < UBounds(InxD) Then
Coords(InxD) = Coords(InxD) + 1
Exit For
Else
Coords(InxD) = LBounds(InxD)
End If
Next
InxA = InxA + 1 ' Step index into MDSArray to match Coords
If InxA > InxMax Then
Exit Do
End If
'' Output co-ordinates to show which elements caused increase in width
'Debug.Print "(";
'For InxD = 1 To DimMax - 1
' Debug.Print Coords(InxD) & ", ";
'Next
'Debug.Print Coords(DimMax) & ") ";
Loop
'Debug.Print
' Output header
Debug.Print "Value for each element in MDSArray"
Debug.Print "|";
For InxD = 1 To DimMax - 1
Debug.Print PadR("D" & CStr(InxD), ColWidthsNotLast(InxD)) & "|";
Next
Debug.Print "|";
For InxWL = LBounds(DimMax) To UBounds(DimMax)
Debug.Print PadR(CStr(InxWL), ColWidthsLast(InxWL)) & "|";
Next
Debug.Print
' Output data rows.
' One row for each value of each index for every dimension except last
' Left of row contains indices for dimensions other thsn last
' Right of row contains values for each index into last dimension
' Initialise Coords to indices for first entry in MDS array
For InxC = 1 To DimMax
Coords(InxC) = LBounds(InxC)
Next
InxA = 1
Do While InxA <= InxMax
Debug.Print "|";
' Output current index for dimensions except last
For InxD = 1 To DimMax - 1
Debug.Print PadR(Coords(InxD), ColWidthsNotLast(InxD)) & "|";
Next
Debug.Print "|";
' Output values for each index into last dimension
Do While True
Debug.Print PadR(MDSArray(InxA), ColWidthsLast(Coords(DimMax))) & "|";
' Step Coords to next entry
For InxD = DimMax To 1 Step -1
If Coords(InxD) < UBounds(InxD) Then
Coords(InxD) = Coords(InxD) + 1
Exit For
Else
Coords(InxD) = LBounds(InxD)
End If
Next
InxA = InxA + 1 ' Step index into MDSArray to match Coords
If InxA > InxMax Then
Exit Do
End If
If Coords(DimMax) = LBounds(DimMax) Then
' Start of new row
Debug.Print
Exit Do
End If
Loop
Loop
Debug.Print
End Sub
Public Sub PutElements(ParamArray Params() As Variant)
' Saves one or more strings starting at a specified element within
' the multi-dimensional string array.
' This sub has two compulsory parameters. The declaration uses a ParamArray
' to allow maximum flexibility in the type of those parameters. Effectively,
' this sub has a declaration of:
' PutElements(ByRef Start() As xxxx, ByRef Values() as yyyy) or
' PutElements(ByRef Start() As xxxx, ByVal Values as yyyy) or
' where xxxx can be any of the integer types plus Variant or String.
' and yyyy can be any type that can be converted to a string plus
' Variant providing all the values within the Variant can be
' converted to strings.
' Start is a one-dimensional array with DimMax, integer elements. If the
' type of the array is Variant or String, the element values must be integer
' or an integer held as a string. The bounds of the array are not important.
' A lower bound of one to match dimension one may be convenient but a lower
' bound of zero or some other value may be used if wished.
' If the MDS array has N dimensions, Start must contain N values each of
' which must be within the bounds for the corresponding dimension. Together,
' the values within Start specify an element with the MDS array.
' Values can be a variable of any type that can be converted to a string.
' Alternately, Values can be a one-dimensional array containing one or more
' elements. If Values contains one element, the value of that element will be
' saved to element Start of the MDS array. If Values contains more than one
' element, the values of those elements will be saved to the MDS array
' starting at Start and continuing in the sequence defined at the top of this
' module until all values in Values have been saved or the last element of
' MDSArray has been reached.
'Debug.Print "PutElements"
If DimMax = 0 Then
Debug.Assert False 'Not initialised
Exit Sub
End If
Dim InxA As Long
Dim InxS As Long
Dim InxV As Long
Dim LB As Long
Dim Start() As Long
Dim UB As Long
LB = LBound(Params)
UB = UBound(Params)
If LB + 1 <> UB Then
Debug.Assert False ' There must be exactly two parameters
Exit Sub
End If
If VarType(Params(LB)) < vbArray Then
Debug.Assert False ' First parameter (Start) must be an array
Exit Sub
End If
' Params(Params(LB)) contains values for Start.
InxS = 1
If UBound(Params(LB)) - LBound(Params(LB)) + 1 <> DimMax Then
Debug.Assert False ' Start must have one entry per dimension
Exit Sub
End If
ReDim Start(1 To DimMax)
For InxV = LBound(Params(LB)) To UBound(Params(LB))
' An error here indicates a value that cannot be converted to a Long
Start(InxS) = Params(LB)(InxV)
If Start(InxS) < LBounds(InxS) Or Start(InxS) > UBounds(InxS) Then
Debug.Assert False ' Index is outside range for dimension
Exit Sub
End If
InxS = InxS + 1
Next
InxA = 1
For InxS = 1 To DimMax
InxA = InxA + (Start(InxS) - LBounds(InxS)) * DimOffs(InxS)
Next
'' Report conversion from coordinates to InxA
'Debug.Print "(";
'For InxS = 1 To DimMax - 1
' Debug.Print Start(InxS) & ", ";
'Next
'Debug.Print Start(DimMax) & ") -> " & InxA
If VarType(Params(UB)) < vbArray Then
' Single value to be stored in element defined by Start
'Debug.Assert False
' An error here indicates Params(UB) cannot be converted to a string
MDSArray(InxA) = Params(UB)
Else
' Array of values to be stored starting at element defined by Start
'Debug.Assert False
'Debug.Print "Params(UB) Bounds: " & LBound(Params(UB)) & " To " & UBound(Params(UB))
For InxV = LBound(Params(UB)) To UBound(Params(UB))
MDSArray(InxA) = Params(UB)(InxV)
'Debug.Print Params(UB)(InxV) & " -> (" & InxA & ")"
InxA = InxA + 1
If InxA > InxMax Then
' Have reached end of MDSArray
Exit For
End If
Next
End If
End Sub
答案 2 :(得分：0)
我的答案超出了Stackoverflow的30,000个字符的限制，因此我将其分成了几个部分。这是第2部分。
这部分代码是我的测试例程。我建议您尝试一下。如果没有其他说明，它们将演示如何使用该类的方法。
Option Explicit
Sub Test1()
Dim MyArray1 As New MultDimStrArray
Dim MyArray2 As MultDimStrArray
Dim MyArray3 As MultDimStrArray
Dim Bounds1 As Variant
Dim Bounds2() As String
Set MyArray2 = New MultDimStrArray
Set MyArray3 = New MultDimStrArray
Bounds1 = Array("3 To 10", "2", 5)
ReDim Bounds2(1 To 3)
Bounds2(1) = "3 to 10"
Bounds2(2) = "2"
Bounds2(3) = "5"
' Error-free calls
Call MyArray1.Initialise("3 to 10", "2")
Call MyArray1.OutDiag
Call MyArray2.Initialise(Bounds1)
Call MyArray2.OutDiag
Call MyArray3.Initialise(Bounds2)
Call MyArray3.OutDiag
Call MyArray1.Initialise("3 to 10", 2)
Call MyArray1.OutDiag
Call MyArray1.Initialise(2, "-5 to -2")
Call MyArray1.OutDiag
' Calls that end in an error
Call MyArray1.Initialise("3 to 10", "a")
Call MyArray1.OutDiag
Call MyArray1.Initialise("3 to 2")
Call MyArray1.OutDiag
Call MyArray1.Initialise("2to3")
Call MyArray1.OutDiag
Call MyArray1.Initialise(0)
Call MyArray1.OutDiag
Call MyArray1.Initialise(1.5)
Call MyArray1.OutDiag
Call MyArray1.Initialise("2 to ")
Call MyArray1.OutDiag
Call MyArray1.Initialise(" to 2")
Call MyArray1.OutDiag
End Sub
Sub Test2()
Dim InxD1 As Long
Dim InxD2 As Long
Dim InxD3 As Long
Dim MyArray As New MultDimStrArray
Dim Start As Variant
Dim ValueCrnt As String
Dim Values() As String
Call MyArray.Initialise("3 to 5", 3)
Call MyArray.PutElements(Array(3, 1), _
Array("Three-One", "Three-Two", "Three-Three", _
"Four-One", "Four-Two", "Four-Three", _
"Five-One", "Five-Two", "Five-Three"))
Call MyArray.OutDiag
ReDim Values(0 To 0)
For InxD1 = 3 To 5
For InxD2 = 1 To 3
Start = Array(InxD1, InxD2)
Values(0) = InxD1 & "." & InxD2
Call MyArray.PutElements(Start, Values)
Next
Next
Call MyArray.OutDiag
For InxD1 = 3 To 5
For InxD2 = 1 To 3
Start = Array(InxD1, InxD2)
ValueCrnt = InxD1 & "-" & InxD2
Call MyArray.PutElements(Start, ValueCrnt)
Next
Next
Call MyArray.OutDiag
Call MyArray.Initialise("5 to 10", 3, "-3 to 4")
Debug.Print
ReDim Values(-3 To 4)
For InxD1 = 10 To 5 Step -1
For InxD2 = 1 To 3
Start = Array(InxD1, InxD2, -3)
For InxD3 = -3 To 4
Values(InxD3) = InxD1 & "." & InxD2 & "." & InxD3
Next
Call MyArray.PutElements(Start, Values)
Next
Next
Call MyArray.OutDiag
End Sub
Sub Test3()
Dim InxD1 As Long
Dim InxD2 As Long
Dim InxV As Long
Dim MyArray As New MultDimStrArray
Dim Start As Variant
Dim ValueCrnt As String
Dim Values() As String
Call MyArray.Initialise("3 to 5", 3)
Call MyArray.PutElements(Array(3, 1), _
Array("Three-One", "Three-Two", "Three-Three", _
"Four-One", "Four-Two", "Four-Three", _
"Five-One", "Five-Two", "Five-Three"))
Call MyArray.OutDiag
ReDim Values(1 To 9)
Call MyArray.GetElements(Array(3, 1), Values)
Debug.Print
For InxV = LBound(Values) To UBound(Values)
Debug.Print """" & Values(InxV) & """ ";
Next
Debug.Print
ReDim Values(1 To 3)
Debug.Print
For InxD1 = 3 To 5
Call MyArray.GetElements(Array(InxD1, 1), Values)
For InxV = LBound(Values) To UBound(Values)
Debug.Print """" & Values(InxV) & """ ";
Next
Debug.Print
Next
ReDim Values(1 To 4)
For InxV = LBound(Values) To UBound(Values)
Values(InxV) = "Unchanged"
Next
Call MyArray.GetElements(Array(5, 1), Values)
Debug.Print
For InxV = LBound(Values) To UBound(Values)
Debug.Print """" & Values(InxV) & """ ";
Next
Debug.Print
Debug.Print
For InxD1 = 3 To 5
For InxD2 = 1 To 3
Call MyArray.GetElements(Array(InxD1, InxD2), ValueCrnt)
Debug.Print "(" & InxD1 & ", " & InxD2 & ") contains " & ValueCrnt
Next
Next
End Sub
这些年来，我创建了子例程和函数来执行Excel标准子例程和函数所没有提供的有用任务。我使用PERSONAL.XLSB作为存储所有这些宏的库。这是OutDiag使用的功能之一。
Option Explicit
Public Function PadR(ByVal Str As String, ByVal PadLen As Long, _
Optional ByVal PadChr As String = " ") As String
' Pad Str with trailing PadChr to give a total length of PadLen
' If the length of Str exceeds PadLen, Str will not be truncated
' Nov15 Coded
' 15Sep16 Added PadChr so could pad with characters other than space
If Len(Str) >= PadLen Then
' Do not truncate over length strings
PadR = Str
Else
PadR = Left$(Str & String(PadLen, PadChr), PadLen)
End If
End Function
答案 3 :(得分：0)
VBA阵列，变体和变体阵列
此答案提供了必要的背景知识，以理解其他答案中的某些代码，并了解为什么我拒绝使用替代方法。
要声明简单变量，我写：
Dim A As Long
Dim B As String
Dim C As Boolean
Dim D As Integer
Dim E As Double
VBA提供了一些内部数据类型选择，这些数据类型与其他语言所提供的数据类型并没有很大差异。
VBA还有另一种类型：
将Dim F作为变体
一个Variant可能被认为是无类型的或容器的。如果我写：
A = 5 ' OK because A is Long
A = "abc" ' Will fail a n alphabetic string cannot be saved in a Long
A = "123" ' OK because string "123" is automatically converted to integer 123
另一方面，我可以编写以下内容而没有任何失败：
F = 5
F = "abc"
F = True
F = 1.23
这些值中的每一个都将正确保存。 F可以在当前值适合的任何表达式中使用：
F = 5
F = F + 2
F = "abc"
F = F & "def"
以上陈述均有效，但
F = "abc"
F = F + 2
将失败，因为将F设置为“ abc”后，无法在算术表达式中使用它。
变体还可以容纳Excel工作表，Word文档或任何Office对象。 Variant也可以容纳数组。当Variant持有对象或数组时，语法就好像Variant已成为该对象或数组。所以：
F = Worksheets("Data”)
F.Range("A1") = "abc"
上面，F现在实际上是Worksheet类型的变量，并且F可以访问Worksheet的任何属性或方法。这只是简要介绍了Variants的整个范围；本教程的其余部分仅限于数组。
我可以通过以下两种方式之一将“变体”转换为数组：
1) F = VBA.Array(1, "abc", True)
2) ReDim F(0 To 2)
VBA.Array是一个函数，它返回一维Variant数组，该数组的下限为0，且元素足以容纳提供的值。我也可以写F = Array(1, "abc", True)。功能Array与功能VBA.Array相同，除了下限取决于Option Base命令的当前值和值。
如果要使用功能Array确定下限，则仅使用功能LBound。我没有完全了解Option Base命令的作用和影响，因为它没有完整记录。我已经看到不同Microsoft产品的不同版本之间的差异，我确信这是偶然的。我相信新的Microsoft程序员会假定旧产品在不运行时会以明智的方式运行。如果可以的话，我非常小心地指定上下限。如果无法指定下限，则进行检查。我仍然使用在Excel 2003下编写的例程。我相信在旧例程中遇到的问题并不多，这是因为我避免对未完全记录的Excel的运行方式进行假设。
返回本教程，ReDim F(0 To 2)有效地将F转换为具有三个元素的数组。
先前所有讨论都是关于一维数组。常规的多维数组也是可能的：
Dim G(1 to 5) As Long
Dim H(1 to 5, 1 To 4) As String
Dim I(1 to 5, 1 To 4, 0 To 3) As Boolean
或
Dim G() As Long
Dim H() As String
Dim I() As Boolean
ReDim G(1 to 5)
ReDim H(1 to 5, 1 To 4)
ReDim I(1 to 5, 1 To 4, 0 To 3)
对于第一个块，尺寸的数量和大小在编译时是固定的。在第二个块中，尺寸的数量和大小在运行时设置，并且可以更改。
无论哪种情况，访问的语法都是：
G(n) = 3
H(n, m) = "abc"
I(n, m, o) = True
这种类型的多维不适合您的要求。尽管可以在运行时更改范围，但是不能在ReDim语句中更改维数，但是需要从一长串预先准备好的ReDim语句中选择一个Select语句，其中每个维数可能都有一个。 >
替代方案是参差不齐或参差不齐的数组，尽管它们不会参差不齐。
考虑：
Dim F As Variant
ReDim F(0 To 2)
F(0) = VBA.Array(1, 2, 3)
F(1) = VBA.Array(4, 5, 6)
F(2) = VBA.Array(7, 8, 9)
我将F制成一个三元素数组，然后将F的每个元素制成数组。要访问内部数组的元素，我写：F（n）（m），其中n和m都可以是0、1或2。
我可以继续：
F（0）（0）= VBA.Array（10，11，12）
此更改之后，元素F（0）（0）（0）的值为10，而F（0）（0）（1）的值为11。
我可以无限期地继续进行此操作。我已经读到，VBA对于常规的多维数组有60个维的限制。我没有尝试过，但是我看不到为什么除了内存之外，使用这种技术对尺寸的数量会有任何限制。
该技术似乎与常规多维数组具有相同的局限性。我可以写F（0）（0）或F（0）（0）（0），但不能在运行时更改简单变量的深度。
还有一个问题，即ReDim F（0）（0 To 2）被编译器拒绝为无效语法。这就是为什么我使用VBA.Array将F（0）转换为数组的原因。
解决方案是递归。考虑：
Call ReDimVar(F, "1 To 2", "3 To 4", "0 To 5")
ReDimVar可以：
ReDim F(1 To 2)
Call ReDimVar(F(1), "3 To 4", "0 To 5")
Call ReDimVar(F(2), "3 To 4", "0 To 5")
所有这些都可以通过简单的循环来处理。我拒绝了这项技术，因为递归速度很慢，而且您的问题意味着大量的数据和许多维度。但是，为了证明它可以工作，请尝试以下操作：
Sub TryMDVA()
' Demonstrate how to:
' 1) Convert a Variant into a multi-dimension array
' 2) Store values in every element of that multi-dimension array
' 3) Extract values from every element of that multi-dimension array
Dim Coords() As Long
Dim ElementValue As String
Dim InxB As Long ' Index for both Bounds and Coords
Dim InxD1 As Long
Dim InxD2 As Long
Dim InxD3 As Long
Dim LwrBnds As Variant
Dim MDVA As Variant
Dim UppBnds As Variant
LwrBnds = Array(1, 0, -3)
UppBnds = Array(2, 5, 4)
ReDim Bounds(LBound(LwrBnds) To UBound(LwrBnds))
ReDim Coords(LBound(LwrBnds) To UBound(LwrBnds))
Call FormatMDVA(MDVA, LwrBnds, UppBnds)
Debug.Print "Results of formatting MDVA"
Debug.Print "Bounds of MDVA are " & LBound(MDVA) & " to " & UBound(MDVA)
Debug.Print "Bounds of MDVA(1) are " & LBound(MDVA(1)) & " to " & UBound(MDVA(1))
Debug.Print "Bounds of MDVA(2) are " & LBound(MDVA(2)) & " to " & UBound(MDVA(2))
Debug.Print "Bounds or MDVA(1)(0) are " & LBound(MDVA(1)(0)) & " to " & UBound(MDVA(1)(0))
Debug.Print "Bounds or MDVA(2)(5) are " & LBound(MDVA(2)(5)) & " to " & UBound(MDVA(2)(5))
' Initialise Coords to lower bound of each dimension
For InxB = LBound(LwrBnds) To UBound(LwrBnds)
Coords(InxB) = LwrBnds(InxB)
Next
Do While True
' Build element value from coordinates
ElementValue = Coords(LBound(Coords))
For InxB = LBound(LwrBnds) + 1 To UBound(LwrBnds)
ElementValue = ElementValue & "." & Coords(InxB)
Next
' Store element value in element of MDVA specified by Coords
Call PutElement(MDVA, Coords, ElementValue)
' Step Coords. Think of Coords as a speedometer with each wheel marked
' with the available index values for a dimension. Starting on the right,
' check each wheel against the relevant ubound. If it is less than the
' ubound, step it by 1. If it is the upper bound, reset it to the lower
' bound and try the next wheel to the left. If the leftmost wheel is
' to be reset, Coords has been set to all possible values.
For InxB = UBound(LwrBnds) To LBound(LwrBnds) Step -1
If Coords(InxB) < UppBnds(InxB) Then
Coords(InxB) = Coords(InxB) + 1
Exit For
Else
If InxB = LBound(LwrBnds) Then
Exit Do
End If
Coords(InxB) = LwrBnds(InxB)
End If
Next
Loop
Debug.Print "Example values from within MDVA"
Debug.Print "MDVA(1)(0)(-3) = " & MDVA(1)(0)(-3)
Debug.Print "MDVA(1)(0)(-2) = " & MDVA(1)(0)(-2)
Debug.Print "MDVA(2)(3)(0) = " & MDVA(2)(3)(0)
Debug.Print "MDVA(2)(5)(4) = " & MDVA(2)(5)(4)
' Initialise Coords to upper bound of each dimension
For InxB = LBound(UppBnds) To UBound(UppBnds)
Coords(InxB) = UppBnds(InxB)
Next
Debug.Print "List of all values in MDVA"
Do While True
' Output value of element of MDVA identified by Coords
Debug.Print "MDVA(" & Coords(LBound(UppBnds));
For InxB = LBound(UppBnds) + 1 To UBound(UppBnds)
Debug.Print ", " & Coords(InxB);
Next
Debug.Print ") = """ & GetElement(MDVA, Coords) & """"
' Set next value of Coords. Similar to code block in PutElement
' but in the opposite direction
For InxB = UBound(LwrBnds) To LBound(LwrBnds) Step -1
If Coords(InxB) > LwrBnds(InxB) Then
Coords(InxB) = Coords(InxB) - 1
Exit For
Else
If InxB = LBound(LwrBnds) Then
Exit Do
End If
Coords(InxB) = UppBnds(InxB)
End If
Next
Loop
End Sub
Sub FormatMDVA(ByRef MDVA As Variant, LwrBnds As Variant, UppBnds As Variant)
' Size MDVA according to the bounds in the first elements of LwrBnds and
' UppBnds. If there are further elements in LwrBnds and UppBnds, call
' FormatMDVA to format every element of MDVA according to the remaining
' elements.
Dim InxB As Long
Dim InxM As Long
Dim LB As Long
Dim SubLwrBnds As Variant
Dim SubUppBnds As Variant
LB = LBound(LwrBnds)
ReDim MDVA(LwrBnds(LB) To UppBnds(LB))
If LBound(LwrBnds) = UBound(LwrBnds) Then
' All bounds applied
Else
' Another dimension to format
ReDim SubLwrBnds(LB + 1 To UBound(LwrBnds))
ReDim SubUppBnds(LB + 1 To UBound(UppBnds))
' Copy remaining bounds to new arrays
For InxB = LB + 1 To UBound(LwrBnds)
SubLwrBnds(InxB) = LwrBnds(InxB)
SubUppBnds(InxB) = UppBnds(InxB)
Next
For InxM = LwrBnds(LB) To UppBnds(LB)
Call FormatMDVA(MDVA(InxM), SubLwrBnds, SubUppBnds)
Next
End If
End Sub
Function GetElement(ByRef MDVA As Variant, ByRef Coords() As Long) As Variant
' Return the value of the element of MDVA identified by Coords
Dim InxC As Long
Dim LB As Long
Dim SubCoords() As Long
LB = LBound(Coords)
If LB = UBound(Coords) Then
' Have reached innermost array
GetElement = MDVA(Coords(LB))
Else
' At least one more nested array
ReDim SubCoords(LB + 1 To UBound(Coords))
For InxC = LB + 1 To UBound(Coords)
SubCoords(InxC) = Coords(InxC)
Next
GetElement = GetElement(MDVA(Coords(LB)), SubCoords)
End If
End Function
Sub PutElement(ByRef MDVA As Variant, ByRef Coords() As Long, _
ElementValue As Variant)
' Save the value of ElementValue in the element of MDVA identified by Coords
Dim InxC As Long
Dim LB As Long
Dim SubCoords() As Long
LB = LBound(Coords)
If LB = UBound(Coords) Then
' Have reached innermost array
MDVA(Coords(LB)) = ElementValue
Else
' At least one more nested array
ReDim SubCoords(LB + 1 To UBound(Coords))
For InxC = LB + 1 To UBound(Coords)
SubCoords(InxC) = Coords(InxC)
Next
Call PutElement(MDVA(Coords(LB)), SubCoords, ElementValue)
End If
End Sub