VBA阵列片（而不是在Python的意义上） [英] VBA array slices (not in the Pythonic sense)
本文介绍了VBA阵列片（而不是在Python的意义上）的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我应该如何实现这个功能呢？
公共功能ArraySlice（改编为Variant，尺寸为长，指数长）为Variant 这里实施结束功能
假如我想让数组的一个切片。我指定一个数组，一个维度，该维度的，我想切片的索引。
作为一个具体的例子，假设我有以下5×4二维数组
0 1 2 3 4
______________
0 | 1 1 2 3 1
1 | 3 4 2 1 5
2 | 4 5 3 2 6
3 | 3 5 2 1 3
如果水平尺寸为1，纵是2，的返回值ArraySlice（数组，1，3）将是一个1×4二维数组。所选择的尺寸2夷为平地，剩下的唯一值是原本在索引3维2的：
0
____
0 | 3
1 | 1
2 | 2
3 | 1
你会如何在VBA中实现这个？我能想到的唯一的实施将涉及CopyMemory的，除非我有限的尺寸允许和硬codeD每个案件的数量。
的注：这里是我会得到数组的大小 的
更新
下面是操作的一对夫妇更多的例子。
有关二维数组
0 1 2 3 4
______________
0 | 1 1 2 3 1
1 | 3 4 2 1 5
2 | 4 5 3 2 6
3 | 3 5 2 1 3
的结果 ArraySlice（数组，2,2）是
0 1 2 3 4
______________
0 | 4 5 3 2 6
假如我有一个3x3x3的数组包含以下二维片
的这个例子已被更改为更清晰的
0 1 2 0 1 2 0 1 2
0 _________ 1 _________ _________ 2
0 | 1 1 1 0 | 4 4 4 0 | 7 7 7
1 | 2 2 2 1 | 5 5 5 1 | 8 8 8
2 | 3 3 3 2 | 6 6 6 2 | 9 9 9
（如构造）
暗淡ARR（）只要使用ReDim ARR（2，2，2）ARR（0，0，0）= 1
ARR（1，0，0）= 1
ARR（2，0,0）= 1
ARR（0，1，0）= 2
ARR（1，1，0）= 2
ARR（2，1,0）= 2
ARR（0,2，0）= 3
ARR（1,2，0）= 3
ARR（2,2，0）= 3
ARR（0，0，1）= 4
ARR（1，0，1）= 4
ARR（2，0,1）= 4
ARR（0，1，1）= 5
ARR（1，1，1）= 5
ARR（2，1,1）= 5
ARR（0，2,1）= 6
ARR（1，2，1）= 6
ARR（2，2，1）= 6
ARR（0,0，2）= 7
ARR（1，0,2）= 7
ARR（2，0,2）= 7
ARR（0，1，2）= 8
ARR（1，1，2）= 8
ARR（2，1,2）= 8
ARR（0，2,2）= 9
ARR（1，2,2）= 9
ARR（2，2,2）= 9
（该尺寸在数学x一起使用，Y，相对于行/ COLS感ž感）
ArraySlice的结果（数组，3，1）将是3x3x1阵列
0 1 2
0 _________
0 | 4 4 4
1 | 5 5 5
2 | 6 6 6
ArraySlice的结果（数组，2,2）将是3x1x3阵列
0 1 2 0 1 2 0 1 2
0 _________ 1 _________ _________ 2
0 | 3 3 3 0 | 6 6 6 0 | 9 9 9
UPDATE2
有关DavidZemens，下面是一个例子，将允许所涉及的内容更容易追踪：
有关，像这样构成的3x3x3的数组
暗淡ARR（）只要使用ReDim ARR（2，2，2）ARR（0，0，0）=000
ARR（1，0，0）=100
ARR（2，0，0）=200
ARR（0，1，0）=010
ARR（1，1，0）=110
ARR（2，1,0）=210
ARR（0,2，0）=020
ARR（1,2，0）=120
ARR（2,2，0）=220
ARR（0，0，1）=001
ARR（1，0，1）=101
ARR（2，0,1）=201
ARR（0，1，1）=011
ARR（1，1，1）=111
ARR（2，1,1）=211
ARR（0，2,1）=021
ARR（1，2，1）=121
ARR（2，2，1）=221
ARR（0，0，2）=001
ARR（1，0,2）=102
ARR（2，0,2）=202
ARR（0，1，2）=012
ARR（1，1，2）=112
ARR（2，1,2）=212
ARR（0，2,2）=022
ARR（1，2，2）=122
ARR（2，2，2）=222
ArraySlice的结果（数组，3，1）将是3x3x1阵列
0 1 2
0 ___________________
0 | 001101201
1 | 011111211
2 | 021121221
最后更新
下面是完整的解决方案 - 你可以假设数组实现是@GSerg表明在接受的答案。我决定，这更有意义完全展平切片维度，因此，如果一个3x3x3的阵列（魔方）的一个切片3x1x3，它就会被夷为平地，3×3。我还是要解决，其中一个扁平化的一维数组将用这种方法产生一个0维数组的情况。
公共功能ArraySlice（改编为Variant，尺寸长，指数只要）为Variant 'TODO：断言，ARR是一个数组
'TODO：断言尺寸是有效的
'TODO：断言指数是有效的 昏暗arrDims作为整数
arrDims = GetArrayDim（ARR）'N维
昏暗arrType作为整数
arrType = GetArrayType（ARR） 昏暗zeroIndexedDimension作为整数
zeroIndexedDimension =维度 - 1制作索引的尺寸零减去之一，数学更容易
昏暗newArrDims作为整数
newArrDims = arrDims - 1N-1的尺寸，因为我们的指数扁平化尺寸 昏暗的arrDimSizes（）为Variant
昏暗的newArrDimSizes（）为Variant 使用ReDim arrDimSizes（0至arrDims - 1）
使用ReDim newArrDimSizes（0至newArrDims - 1） 昏暗我只要 对于i = 0到arrDims - 1
arrDimSizes（ⅰ）= UBound函数（ARR，I + 1） - LBOUND（ARR，I + 1）+1
下一个 得到原始的每一个相应尺寸的大小
对于i = 0到zeroIndexedDimension - 1
newArrDimSizes（ⅰ）= arrDimSizes㈠
下一个 跳过维因为我们是扁平化 一个获得剩余的尺寸，关
对于i = zeroIndexedDimension要arrDims - 2
newArrDimSizes（ⅰ）= arrDimSizes第（i + 1）
下一个 昏暗newArray为Variant
newArray = CreateArray（arrType，newArrDims，newArrDimSizes）
通过尺寸迭代，复制 昏暗的arrCurIndices（）为Variant
昏暗的newArrCurIndices（）为Variant 使用ReDim arrCurIndices（0至arrDims - 1）
使用ReDim newArrCurIndices（0至newArrDims - 1） arrCurIndices（zeroIndexedDimension）=指数这是片 做虽然1 复制元素
PutArrayElement newArray，GetArrayElement（ARR，arrCurIndices），newArrCurIndices '迭代两个阵列到下一个位置
如果不IncrementIndices（arrCurIndices，arrDimSizes，zeroIndexedDimension）然后
如果我们复制了所有的元素
退出待办事项
万一
IncrementIndices newArrCurIndices，newArrDimSizes
循环 ArraySlice = newArray
结束功能专用功能IncrementIndices（arrIndices为Variant，arrDimensionSizes为Variant，可选zeroIndexedDimension作为整数= -2）为布尔
IncrementArray迭代顺序所有有效指标，鉴于arrDimensionSizes大小
'例如，假设的功能与开始的arrIndices反复调用[0，0，0]和arrDimensionSizes [3,1，3]。
其结果将是arrIndices变化如下：
'[0，0，0]第一个电话
'[0，0，1]
'[0，0，2]
'[1，0,0]
'[1，0,1]
'[1，0,2]
[2，0,0]
[2，0,1]
[2，0,2] '可选的尺寸参数允许的尺寸要冷冻和不包括在迭代。
'例如，假设的功能与开始的[0,1，0]和[3,3，3]和尺寸arrDimensionSizes = 2 arrIndices反复调用
'[0，1，0]第一个电话
'[0，1，1]
'[0，1，2]
'[1，1,0]
'[1，1，1]
'[1，1,2]
[2，1,0]
'[2，1，1]
[2，1,2]
昏暗arrCurDimension作为整数
arrCurDimension = UBound函数（arrIndices） 如果这个维度是全，或者如果它是冷冻尺寸，跳过它寻找一个进
虽然arrIndices（arrCurDimension）= arrDimensionSizes（arrCurDimension） - 1 = arrCurDimension zeroIndexedDimension
'携带
arrCurDimension = arrCurDimension - 1 如果arrCurDimension = -1然后
IncrementIndices =假
退出功能
万一 WEND
arrIndices（arrCurDimension）= arrIndices（arrCurDimension）+1
虽然arrCurDimension＆LT; UBound函数（arrDimensionSizes）
arrCurDimension = arrCurDimension + 1
如果arrCurDimension＆LT;＆GT; zeroIndexedDimension然后
arrIndices（arrCurDimension）= 0
万一
WEND
IncrementIndices = TRUE
结束功能
解决方案
我不知道我完全理解的逻辑和功能参数和结果之间的联系，但已经有一个通用的元素访问功能， SafeArrayGetElement 。它可以让你访问在编译时维未知的数组的元素，所有你需要的是数组指针的 （仅供参考; $ C $在这个答案C已被改进）的
在一个单独的模块
显式的选项私人声明函数库GetMem2MSVBVM60（BYVAL PSRC长，BYVAL pDst长）只要'与CopyMemory的更换，如果感到很内疚
私人声明函数库GetMem4MSVBVM60（BYVAL PSRC长，BYVAL pDst长）只要'与CopyMemory的更换，如果感到很内疚
私人声明函数库PutMem2MSVBVM60（BYVAL pDst长，BYVAL的NewValue为整数），只要'与CopyMemory的更换，如果感到很内疚
私人声明函数库PutMem4MSVBVM60（BYVAL pDst长，BYVAL的NewValue长）只要'与CopyMemory的更换，如果感到很内疚私人声明函数库SafeArrayGetElement的oleaut32.dll（BYVAL PSA长，为ByRef rgIndices长，为ByRef PV作为任意）只要
私人声明函数库SafeArrayGetVartype的oleaut32.dll（BYVAL PSA长，为ByRef PVT作为整数）只要私人常量VT_BYREF只要=安培; H4000＆安培;
私人常量S_OK只要=安培; H0＆安培;
专用功能pArrPtr（ARR的ByRef为Variant）只要'警告：回报* SAFEARRAY，不** SAFEARRAY
VarType函数谎言给你，隐瞒重要区别。手动VarType函数在这里。
昏暗的VT作为整数
GetMem2 BYVAL VarPtr（ARR），BYVAL VarPtr（VT） 如果（VT和VBArray的）LT;＆GT; VBArray的再
Err.Raise 5，变种必须包含数组
万一
看到https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
如果（VT和VT_BYREF）= VT_BYREF然后
通过-REF变量数组。包含** pparray偏移8
GetMem4 BYVAL VarPtr（ARR）+ 8，BYVAL VarPtr（pArrPtr）'pArrPtr = arr-＆GT; pparray;
GetMem4 BYVAL pArrPtr，BYVAL VarPtr（pArrPtr）'pArrPtr = * pArrPtr;
其他
非由-REF变量数组。包含*粒子阵列偏移8
GetMem4 BYVAL VarPtr（ARR）+ 8，BYVAL VarPtr（pArrPtr）'pArrPtr = arr-＆GT;粒子阵列;
万一结束功能
公共职能GetArrayElement（改编为ByRef为Variant，指数的ParamArray（）为Variant）为Variant 昏暗pSafeArray只要
pSafeArray = pArrPtr（ARR） 昏暗的long_indices（）只要
使用ReDim long_indices（0至UBound函数（指数） - LBOUND（指数）） 昏暗我只要
对于i = LBOUND（long_indices）为UBound函数（long_indices）
long_indices（ⅰ）=指数（LBOUND（指数）+ I）
下一个
'类型安全检查 - 删除/缓存，如果你知道自己在做什么。
昏暗HRESULT只要 昏暗的VT作为整数
HRESULT = SafeArrayGetVartype（pSafeArray，VT） 如果HRESULT＆LT;＆GT; S_OK然后Err.Raise HRESULT，无法获取数组变种类型。
选择案例VT
案例vbVariant
HRESULT = SafeArrayGetElement（BYVAL pSafeArray，long_indices（LBOUND（long_indices）），GetArrayElement）
案例vbBoolean，vbCurrency，vbDate，vbDecimal，vbByte，vbInteger，vbLong，是vbNull，vbEmpty，vbSingle，vbDouble，vbString，vbObject
HRESULT = SafeArrayGetElement（BYVAL pSafeArray，long_indices（LBOUND（long_indices）），BYVAL VarPtr（GetArrayElement）+ 8）
如果HRESULT = S_OK然后PutMem2 BYVAL VarPtr（GetArrayElement），VT
否则案例
Err.Raise 5，不支持数组元素类型
结束选择 如果HRESULT＆LT;＆GT; S_OK然后Err.Raise HRESULT，无法获取数组元素。
结束功能
用法：
私人小组Command1_Click（）
昏暗arrVariantByRef（）为Variant
使用ReDim arrVariantByRef（1至2，1至3个） 昏暗arrVariantNonByRef为Variant
使用ReDim arrVariantNonByRef（1至2，1至3个） 昏暗的arrOfLongs（）只要
使用ReDim arrOfLongs（1至2，1至3个） 昏暗的arrOfStrings（）作为字符串
使用ReDim arrOfStrings（1至2，1至3个） 昏暗的arrOfObjects（）作为对象
使用ReDim arrOfObjects（1至2，1至3个） 昏暗的arrOfDates（）截至日期
使用ReDim arrOfDates（1至2，1至3个） arrVariantByRef（2,3）= 42
arrVariantNonByRef（2,3）= 42
arrOfLongs（2,3）= 42
arrOfStrings（2,3）=42！
集arrOfObjects（2，3）=我
arrOfDates（2，3）=立即 MSGBOX GetArrayElement（arrVariantByRef，2，3）
MSGBOX GetArrayElement（arrVariantNonByRef，2，3）
MSGBOX GetArrayElement（arrOfLongs，2，3）
MSGBOX GetArrayElement（arrOfStrings，2，3）
MSGBOX GetArrayElement（arrOfObjects，2，3）.Caption
MSGBOX GetArrayElement（arrOfDates，2，3）结束小组
我相信你可以很容易地使用这个基块构建你的逻辑，虽然它可能比你要慢。结果
有在code，你可以删除一些类型检查 - 那么它会更快，但你必须确保你只有通过正确的基础类型的数组。您也可以缓存粒子阵列，使 GetArrayElement 接受而不是原始的数组。
How should I implement this function?
Public Function ArraySlice(arr As Variant, dimension as Long, index as Long) As Variant
'Implementation here
End Function
Suppose I wanted a slice of an array. I specify an array, a dimension and an index on that dimension for which I want the slice.
As a concrete example, suppose I have the following 5x4 2D array
0 1 2 3 4
______________
0| 1 1 2 3 1
1| 3 4 2 1 5
2| 4 5 3 2 6
3| 3 5 2 1 3
If the horizontal dimension is 1 and the vertical is 2, the return value of ArraySlice(array, 1, 3) would be a 1x4 2D array. The chosen dimension 2 was flattened and the only remaining values are the ones that were originally at index 3 on dimension 2:
0
____
0| 3
1| 1
2| 2
3| 1
How would you implement this in VBA? The only implementations I can think of would involve CopyMemory unless I limited the number of dimensions allowable and hard coded every case.
NOTE: Here is how I would get the dimensions of the array
UPDATE
Here are a couple more examples of the operation
For the 2D array
0 1 2 3 4
______________
0| 1 1 2 3 1
1| 3 4 2 1 5
2| 4 5 3 2 6
3| 3 5 2 1 3
The result of ArraySlice(array, 2, 2) would be
0 1 2 3 4
______________
0| 4 5 3 2 6
Suppose I had a 3x3x3 array comprised of the following 2 dimensional slices this example has been changed to make it clearer
0 1 2 0 1 2 0 1 2
0 _________ 1 _________ 2 _________
0| 1 1 1 0| 4 4 4 0| 7 7 7
1| 2 2 2 1| 5 5 5 1| 8 8 8
2| 3 3 3 2| 6 6 6 2| 9 9 9
(constructed like so)
Dim arr() As Long
ReDim arr(2, 2, 2)
arr(0, 0, 0) = 1
arr(1, 0, 0) = 1
arr(2, 0, 0) = 1
arr(0, 1, 0) = 2
arr(1, 1, 0) = 2
arr(2, 1, 0) = 2
arr(0, 2, 0) = 3
arr(1, 2, 0) = 3
arr(2, 2, 0) = 3
arr(0, 0, 1) = 4
arr(1, 0, 1) = 4
arr(2, 0, 1) = 4
arr(0, 1, 1) = 5
arr(1, 1, 1) = 5
arr(2, 1, 1) = 5
arr(0, 2, 1) = 6
arr(1, 2, 1) = 6
arr(2, 2, 1) = 6
arr(0, 0, 2) = 7
arr(1, 0, 2) = 7
arr(2, 0, 2) = 7
arr(0, 1, 2) = 8
arr(1, 1, 2) = 8
arr(2, 1, 2) = 8
arr(0, 2, 2) = 9
arr(1, 2, 2) = 9
arr(2, 2, 2) = 9
(the dimensions are used in the mathematical x, y, z sense as opposed to the rows/cols sense)
The result of ArraySlice(array, 3, 1) would be the 3x3x1 array
0 1 2
0 _________
0| 4 4 4
1| 5 5 5
2| 6 6 6
The result of ArraySlice(array, 2, 2) would be the 3x1x3 array
0 1 2 0 1 2 0 1 2
0 _________ 1 _________ 2 _________
0| 3 3 3 0| 6 6 6 0| 9 9 9
UPDATE2
For DavidZemens, here is an example that would allow easier tracking of the elements involved:
For a 3x3x3 array constructed like so
Dim arr() As Long
ReDim arr(2, 2, 2)
arr(0, 0, 0) = "000"
arr(1, 0, 0) = "100"
arr(2, 0, 0) = "200"
arr(0, 1, 0) = "010"
arr(1, 1, 0) = "110"
arr(2, 1, 0) = "210"
arr(0, 2, 0) = "020"
arr(1, 2, 0) = "120"
arr(2, 2, 0) = "220"
arr(0, 0, 1) = "001"
arr(1, 0, 1) = "101"
arr(2, 0, 1) = "201"
arr(0, 1, 1) = "011"
arr(1, 1, 1) = "111"
arr(2, 1, 1) = "211"
arr(0, 2, 1) = "021"
arr(1, 2, 1) = "121"
arr(2, 2, 1) = "221"
arr(0, 0, 2) = "001"
arr(1, 0, 2) = "102"
arr(2, 0, 2) = "202"
arr(0, 1, 2) = "012"
arr(1, 1, 2) = "112"
arr(2, 1, 2) = "212"
arr(0, 2, 2) = "022"
arr(1, 2, 2) = "122"
arr(2, 2, 2) = "222"
The result of ArraySlice(array, 3, 1) would be the 3x3x1 array
0 1 2
0 ___________________
0| "001" "101" "201"
1| "011" "111" "211"
2| "021" "121" "221"
FINAL UPDATE
Here is the complete solution - you can assume that the Array functions are implemented as @GSerg suggests in the accepted answer. I decided that it makes more sense to completely flatten the sliced dimension, so if a slice of a 3x3x3 array ("cube") is 3x1x3, it gets flattened to 3x3. I still have to resolve the case where flattening a 1 dimensional array would yield a 0 dimensional array by this method.
Public Function ArraySlice(arr As Variant, dimension As Long, index As Long) As Variant
'TODO: Assert that arr is an Array
'TODO: Assert dimension is valid
'TODO: Assert index is valid
Dim arrDims As Integer
arrDims = GetArrayDim(arr) 'N dimensions
Dim arrType As Integer
arrType = GetArrayType(arr)
Dim zeroIndexedDimension As Integer
zeroIndexedDimension = dimension - 1 'Make the dimension zero indexed by subtracting one, for easier math
Dim newArrDims As Integer
newArrDims = arrDims - 1 'N-1 dimensions since we're flattening "dimension" on "index"
Dim arrDimSizes() As Variant
Dim newArrDimSizes() As Variant
ReDim arrDimSizes(0 To arrDims - 1)
ReDim newArrDimSizes(0 To newArrDims - 1)
Dim i As Long
For i = 0 To arrDims - 1
arrDimSizes(i) = UBound(arr, i + 1) - LBound(arr, i + 1) + 1
Next
'Get the size of each corresponding dimension of the original
For i = 0 To zeroIndexedDimension - 1
newArrDimSizes(i) = arrDimSizes(i)
Next
'Skip over "dimension" since we're flattening it
'Get the remaining dimensions, off by one
For i = zeroIndexedDimension To arrDims - 2
newArrDimSizes(i) = arrDimSizes(i + 1)
Next
Dim newArray As Variant
newArray = CreateArray(arrType, newArrDims, newArrDimSizes)
'Iterate through dimensions, copying
Dim arrCurIndices() As Variant
Dim newArrCurIndices() As Variant
ReDim arrCurIndices(0 To arrDims - 1)
ReDim newArrCurIndices(0 To newArrDims - 1)
arrCurIndices(zeroIndexedDimension) = index 'This is the slice
Do While 1
'Copy the element
PutArrayElement newArray, GetArrayElement(arr, arrCurIndices), newArrCurIndices
'Iterate both arrays to the next position
If Not IncrementIndices(arrCurIndices, arrDimSizes, zeroIndexedDimension) Then
'If we've copied all the elements
Exit Do
End If
IncrementIndices newArrCurIndices, newArrDimSizes
Loop
ArraySlice = newArray
End Function
Private Function IncrementIndices(arrIndices As Variant, arrDimensionSizes As Variant, Optional zeroIndexedDimension As Integer = -2) As Boolean
'IncrementArray iterates sequentially through all valid indices, given the sizes in arrDimensionSizes
'For example, suppose the function is called repeatedly with starting arrIndices of [0, 0, 0] and arrDimensionSizes of [3, 1, 3].
'The result would be arrIndices changing as follows:
'[0, 0, 0] first call
'[0, 0, 1]
'[0, 0, 2]
'[1, 0, 0]
'[1, 0, 1]
'[1, 0, 2]
'[2, 0, 0]
'[2, 0, 1]
'[2, 0, 2]
'The optional "dimension" parameter allows a dimension to be frozen and not included in the iteration.
'For example, suppose the function is called repeatedly with starting arrIndices of [0, 1, 0] and arrDimensionSizes of [3, 3, 3] and dimension = 2
'[0, 1, 0] first call
'[0, 1, 1]
'[0, 1, 2]
'[1, 1, 0]
'[1, 1, 1]
'[1, 1, 2]
'[2, 1, 0]
'[2, 1, 1]
'[2, 1, 2]
Dim arrCurDimension As Integer
arrCurDimension = UBound(arrIndices)
'If this dimension is "full" or if it is the frozen dimension, skip over it looking for a carry
While arrIndices(arrCurDimension) = arrDimensionSizes(arrCurDimension) - 1 Or arrCurDimension = zeroIndexedDimension
'Carry
arrCurDimension = arrCurDimension - 1
If arrCurDimension = -1 Then
IncrementIndices = False
Exit Function
End If
Wend
arrIndices(arrCurDimension) = arrIndices(arrCurDimension) + 1
While arrCurDimension < UBound(arrDimensionSizes)
arrCurDimension = arrCurDimension + 1
If arrCurDimension <> zeroIndexedDimension Then
arrIndices(arrCurDimension) = 0
End If
Wend
IncrementIndices = True
End Function
解决方案
I'm not sure I fully understand the logic and the connection between the function arguments and the result, but there already is a generic element accessor function, SafeArrayGetElement. It lets you access an element of an array with dimensions unknown at compile time, all you need is the array pointer (for reference only; code in this answer has been improved).
In a separate module:
Option Explicit
Private Declare Function GetMem2 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long ' Replace with CopyMemory if feel bad about it
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long ' Replace with CopyMemory if feel bad about it
Private Declare Function PutMem2 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Integer) As Long ' Replace with CopyMemory if feel bad about it
Private Declare Function PutMem4 Lib "msvbvm60" (ByVal pDst As Long, ByVal NewValue As Long) As Long ' Replace with CopyMemory if feel bad about it
Private Declare Function SafeArrayGetElement Lib "oleaut32.dll" (ByVal psa As Long, ByRef rgIndices As Long, ByRef pv As Any) As Long
Private Declare Function SafeArrayGetVartype Lib "oleaut32.dll" (ByVal psa As Long, ByRef pvt As Integer) As Long
Private Const VT_BYREF As Long = &H4000&
Private Const S_OK As Long = &H0&
Private Function pArrPtr(ByRef arr As Variant) As Long 'Warning: returns *SAFEARRAY, not **SAFEARRAY
'VarType lies to you, hiding important differences. Manual VarType here.
Dim vt As Integer
GetMem2 ByVal VarPtr(arr), ByVal VarPtr(vt)
If (vt And vbArray) <> vbArray Then
Err.Raise 5, , "Variant must contain an array"
End If
'see https://msdn.microsoft.com/en-us/library/windows/desktop/ms221627%28v=vs.85%29.aspx
If (vt And VT_BYREF) = VT_BYREF Then
'By-ref variant array. Contains **pparray at offset 8
GetMem4 ByVal VarPtr(arr) + 8, ByVal VarPtr(pArrPtr) 'pArrPtr = arr->pparray;
GetMem4 ByVal pArrPtr, ByVal VarPtr(pArrPtr) 'pArrPtr = *pArrPtr;
Else
'Non-by-ref variant array. Contains *parray at offset 8
GetMem4 ByVal VarPtr(arr) + 8, ByVal VarPtr(pArrPtr) 'pArrPtr = arr->parray;
End If
End Function
Public Function GetArrayElement(ByRef arr As Variant, ParamArray indices() As Variant) As Variant
Dim pSafeArray As Long
pSafeArray = pArrPtr(arr)
Dim long_indices() As Long
ReDim long_indices(0 To UBound(indices) - LBound(indices))
Dim i As Long
For i = LBound(long_indices) To UBound(long_indices)
long_indices(i) = indices(LBound(indices) + i)
Next
'Type safety checks - remove/cache if you know what you're doing.
Dim hresult As Long
Dim vt As Integer
hresult = SafeArrayGetVartype(pSafeArray, vt)
If hresult <> S_OK Then Err.Raise hresult, , "Cannot get array var type."
Select Case vt
Case vbVariant
hresult = SafeArrayGetElement(ByVal pSafeArray, long_indices(LBound(long_indices)), GetArrayElement)
Case vbBoolean, vbCurrency, vbDate, vbDecimal, vbByte, vbInteger, vbLong, vbNull, vbEmpty, vbSingle, vbDouble, vbString, vbObject
hresult = SafeArrayGetElement(ByVal pSafeArray, long_indices(LBound(long_indices)), ByVal VarPtr(GetArrayElement) + 8)
If hresult = S_OK Then PutMem2 ByVal VarPtr(GetArrayElement), vt
Case Else
Err.Raise 5, , "Unsupported array element type"
End Select
If hresult <> S_OK Then Err.Raise hresult, , "Cannot get array element."
End Function
Usage:
Private Sub Command1_Click()
Dim arrVariantByRef() As Variant
ReDim arrVariantByRef(1 To 2, 1 To 3)
Dim arrVariantNonByRef As Variant
ReDim arrVariantNonByRef(1 To 2, 1 To 3)
Dim arrOfLongs() As Long
ReDim arrOfLongs(1 To 2, 1 To 3)
Dim arrOfStrings() As String
ReDim arrOfStrings(1 To 2, 1 To 3)
Dim arrOfObjects() As Object
ReDim arrOfObjects(1 To 2, 1 To 3)
Dim arrOfDates() As Date
ReDim arrOfDates(1 To 2, 1 To 3)
arrVariantByRef(2, 3) = 42
arrVariantNonByRef(2, 3) = 42
arrOfLongs(2, 3) = 42
arrOfStrings(2, 3) = "42!"
Set arrOfObjects(2, 3) = Me
arrOfDates(2, 3) = Now
MsgBox GetArrayElement(arrVariantByRef, 2, 3)
MsgBox GetArrayElement(arrVariantNonByRef, 2, 3)
MsgBox GetArrayElement(arrOfLongs, 2, 3)
MsgBox GetArrayElement(arrOfStrings, 2, 3)
MsgBox GetArrayElement(arrOfObjects, 2, 3).Caption
MsgBox GetArrayElement(arrOfDates, 2, 3)
End Sub
I believe you can easily build your logic using this base block, although it might be slower than you want.
There are some type checks in the code which you can remove - then it will be faster, but you will have to make sure you only pass arrays of correct underlying type. You can also cache the pArray and make GetArrayElement accept that instead of a raw array.
这篇关于VBA阵列片（而不是在Python的意义上）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
