logo标签列表

VBA数组切片（不是Pythonic意义上的）

arraysvba
9
我该如何实现这个功能？
Public Function ArraySlice(arr As Variant, dimension as Long, index as Long) As Variant

    'Implementation here

End Function

假设我想要一个数组的切片。我需要指定一个数组，一个维度和该维度上所需切片的索引。
举个具体的例子，假设我有一个5x4的二维数组：
   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(array, 1, 3) 的返回值将是一个1x4的2D数组。所选的第二维被压缩，唯一剩下的值是最初在第二维的索引3处的值：
   0
  ____
0| 3
1| 1
2| 2
3| 1

你会怎样在VBA中实现这个操作？我所能想到的唯一方式是使用CopyMemory，除非我限制数组可允许的维度并硬编码每个情况。
注意：这里是获取数组维度的方法 更新：
以下是操作的另外两个例子：
对于二维数组：
   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
< p > ArraySlice(array, 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

（构造方式如下）
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

(这里的尺寸是指数学中的x、y、z，而不是行/列的概念)

ArraySlice(array, 3, 1)的结果将是一个3x3x1的数组。

     0  1  2
0   _________
  0| 4  4  4  
  1| 5  5  5  
  2| 6  6  6
ArraySlice(array, 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

更新2

对于DavidZemens，这里有一个例子可以更轻松地跟踪涉及的元素：

对于构造如下的3x3x3数组

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"
ArraySlice(array, 3, 1) 的结果将是一个 3x3x1 的数组。该函数与数组切片有关，可以用于提取原始数组的子集。
       0     1     2
0   ___________________
  0| "001" "101" "201"  
  1| "011" "111" "211"
  2| "021" "121" "221"

最终更新

这里是完整的解决方案 - 您可以假设数组函数已按照 @GSerg 在被接受的答案中所建议的实现。我决定完全展开被切片的维度，因此，如果一个3x3x3数组（“立方体”）的一个切片是3x1x3，则它将被展平为3x3。但我仍需要解决一种情况：按此方法展开一维数组会产生零维数组的情况。

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
1
我不确定我是否理解具体的问题，但您是否尝试过Ron de Bruin发布的任何帮助函数？特别是其中有一个测试数组维数的函数，另一个测试数组是否真正“分配”等。 - David Zemens
1
@DavidZemens 我会更进一步，给你提供代码，这样你可以自己操作玩耍！ - Blackhawk
2
我可以想象编写这个函数来处理只有2D数组或只有3D数组，但是将其概括为处理任意数量（受VBA限制的极限）的有限维度才是真正困难的挑战。 - Blackhawk
1
你真的需要处理未知数量的维度吗？并且每个维度上的数组也需要考虑未知数量的维度吗？例如，您可能需要处理像Dim arr(5, 6, 3, 1 to 9)这样的数组。我的意思是，如果您有一些已知的约束条件，则应该可以处理此“问题”，尽管没有简单的方法来解决它。如果您确实必须考虑每种可能的组合，我认为您就无能为力了。 - David Zemens
1
你可以将数组完全展开成ArrayList，然后根据维度数量等使用一些花哨的模块化迭代。但我不确定这是否比暴力嵌套循环更好，而且我的Excel刚刚在没有“恢复”面板的情况下崩溃了，所以我失去了我的尝试... - David Zemens
显示剩余18条评论
3个回答
7
注意：代码已更新，原始版本可以在修订历史中找到（尽管它并没有什么用）。更新后的代码不依赖于未记录的GetMem *函数，并且与Office 64位兼容。
我不确定是否完全理解函数参数和结果之间的逻辑和联系，但已经有一个通用元素访问器函数SafeArrayGetElement。它允许您使用在编译时未知的维度访问数组的元素，您只需要数组指针即可。
在单独的模块中：
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As LongPtr)
  Private Declare PtrSafe Function SafeArrayGetElement Lib "oleaut32.dll" (ByVal psa As LongPtr, ByRef rgIndices As Long, ByRef pv As Any) As Long
  Private Declare PtrSafe Function SafeArrayGetVartype Lib "oleaut32.dll" (ByVal psa As LongPtr, ByRef pvt As Integer) As Long
#Else
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
  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
#End If

Private Const VT_BYREF As Long = &H4000&
Private Const S_OK As Long = &H0&

' When declared in this way, the passed array is wrapped in a Variant/ByRef. It is not copied.
' Returns *SAFEARRAY, not **SAFEARRAY
#If VBA7 Then
Private Function pArrPtr(ByRef arr As Variant) As LongPtr
#Else
Private Function pArrPtr(ByRef arr As Variant) As Long
#End If
  'VarType lies to you, hiding important differences. Manual VarType here.
  Dim vt As Integer
  CopyMemory ByVal VarPtr(vt), ByVal VarPtr(arr), Len(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
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->pparray;
    CopyMemory ByVal VarPtr(pArrPtr), ByVal pArrPtr, Len(pArrPtr)          'pArrPtr = *pArrPtr;
  Else
    'Non-by-ref variant array. Contains *parray at offset 8
    CopyMemory ByVal VarPtr(pArrPtr), ByVal VarPtr(arr) + 8, Len(pArrPtr)  'pArrPtr = arr->parray;
  End If
End Function


Public Function GetArrayElement(ByRef arr As Variant, ParamArray indices() As Variant) As Variant

#If VBA7 Then
  Dim pSafeArray As LongPtr
#Else
  Dim pSafeArray As Long
#End If

  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 CopyMemory ByVal VarPtr(GetArrayElement), ByVal VarPtr(vt), Len(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

使用方法：

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

我相信你可以很容易地使用这个基本块构建逻辑，尽管它可能比你想要的慢一些。
代码中有一些类型检查，你可以去掉它们 - 这样会更快，但你必须确保只传递正确底层类型的数组。你还可以缓存 pArray 并使 GetArrayElement 接受它而不是原始数组。
现在我写了这些，我在想是否将所有60个情况硬编码实际上是一件坏事（VBA数组中最多可以有60个维度）？你最终会得到一个大的select case num，其中每行都会访问具有增加维度数量的数组。实际上，你甚至不会使用60个维度，因为即使所有六十个维度都像（0到1）一样小，也会立即出现内存不足的情况。 - GSerg
是的！这正是我在寻找的东西！至于我要解决的问题，想象一下一个由九个儿童积木组成的立方体。你可以从这个立方体中取出“切片”：顶部的九个积木，或者底部或者中间；同样地，你也可以取出形成左侧面或右侧面、背面或前面的九个积木作为切片。这就是我的问题所涉及的，只不过在任意维度上。在一个二维的3x3数组中，一个切片要么是3x1，要么是1x3，这取决于你切割的维度。 - Blackhawk
我选择使用SafeArrayCreate()来创建动态数组，并将其作为Variant返回，这部分很好。我查阅了COM自动化文档，发现只有完整的对象才会获得引用计数，因此VBA可以正确处理Variant/Array的销毁。我目前正在尝试适应put/get函数。 - Blackhawk
一个注意事项，根据 MSDN SafeArrayGetElement 页面的说明，“数组每个维度的索引向量。最右边（最低有效位）的维度是 rgIndices[0]。最左边的维度存储在 rgIndices[psa->cDims – 1] 中。” 这是否意味着我在从 indices() 复制到 long_indices() 时需要反转顺序？ - Blackhawk
@Blackhawk 我也是这么想的，然后我把它们反过来了，但是它没有起作用。然后我停止了反转它们，它就起作用了。 - GSerg
我还没有完全完成ArraySlice的实现，但是PutArrayElement、GetArrayElement和CreateArray已经完成了。在GetArrayElement中，我做了一件事情，就是添加了ParamArray解包 - 有时候仅仅提供一个单独的数组而不是多个参数是很方便甚至必要的，所以有一个检查来判断indices(0)是否为数组，如果是，则直接使用它。我已经拥有构建ArraySlice所需的所有组件，并将其作为问题的更新发布。感谢您的帮助！ - Blackhawk
3

以下是完整代码，输入的arr参数是1、2或3维数组，1维数组将返回false。

Public Function ArraySlice(arr As Variant, dimension As Long, index As Long) As Variant
Dim arrDimension() As Byte
Dim retArray()
Dim i As Integer, j As Integer
Dim arrSize As Long

' Get array dimension and size
On Error Resume Next
For i = 1 To 3
    arrSize = 0
    arrSize = CInt(UBound(arr, i))
    If arrSize <> 0 Then
        ReDim Preserve arrDimension(i)
        arrDimension(i) = UBound(arr, i)
    End If
Next i
On Error GoTo 0

Select Case UBound(arrDimension)
Case 2
    If dimension = 1 Then
        ReDim retArray(arrDimension(2))
        For i = 0 To arrDimension(2)
            retArray(i) = arr(index, i)
        Next i
    ElseIf dimension = 2 Then
        ReDim retArray(arrDimension(1))
        For i = 0 To arrDimension(1)
            retArray(i) = arr(i, index)
        Next i
    End If

Case 3
    If dimension = 1 Then
        ReDim retArray(0, arrDimension(2), arrDimension(3))
        For j = 0 To arrDimension(3)
            For i = 0 To arrDimension(2)
                retArray(0, i, j) = arr(index, i, j)
            Next i
        Next j
    ElseIf dimension = 2 Then
        ReDim retArray(arrDimension(1), 0, arrDimension(3))
        For j = 0 To arrDimension(3)
            For i = 0 To arrDimension(1)
                retArray(i, 0, j) = arr(i, index, j)
            Next i
        Next j
    ElseIf dimension = 3 Then
        ReDim retArray(arrDimension(1), arrDimension(2), 0)
        For j = 0 To arrDimension(2)
            For i = 0 To arrDimension(1)
                retArray(i, j, 0) = arr(i, j, index)
            Next i
        Next j
    End If

Case Else
    ArraySlice = False
    Exit Function

End Select

ArraySlice = retArray
End Function


只需使用以下代码进行测试

Sub test()
Dim arr2D()
Dim arr3D()
Dim ret

ReDim arr2D(4, 3)
arr2D(0, 0) = 1
arr2D(1, 0) = 1
arr2D(2, 0) = 2
arr2D(3, 0) = 3
arr2D(4, 0) = 1
arr2D(0, 1) = 3
arr2D(1, 1) = 4
arr2D(2, 1) = 2
arr2D(3, 1) = 1
arr2D(4, 1) = 5
arr2D(0, 2) = 4
arr2D(1, 2) = 5
arr2D(2, 2) = 3
arr2D(3, 2) = 2
arr2D(4, 2) = 6
arr2D(0, 3) = 3
arr2D(1, 3) = 5
arr2D(2, 3) = 2
arr2D(3, 3) = 1
arr2D(4, 3) = 3

ReDim arr3D(2, 2, 2)
arr3D(0, 0, 0) = 1
arr3D(1, 0, 0) = 1
arr3D(2, 0, 0) = 1
arr3D(0, 1, 0) = 2
arr3D(1, 1, 0) = 2
arr3D(2, 1, 0) = 2
arr3D(0, 2, 0) = 3
arr3D(1, 2, 0) = 3
arr3D(2, 2, 0) = 3
arr3D(0, 0, 1) = 4
arr3D(1, 0, 1) = 4
arr3D(2, 0, 1) = 4
arr3D(0, 1, 1) = 5
arr3D(1, 1, 1) = 5
arr3D(2, 1, 1) = 5
arr3D(0, 2, 1) = 6
arr3D(1, 2, 1) = 6
arr3D(2, 2, 1) = 6
arr3D(0, 0, 2) = 7
arr3D(1, 0, 2) = 7
arr3D(2, 0, 2) = 7
arr3D(0, 1, 2) = 8
arr3D(1, 1, 2) = 8
arr3D(2, 1, 2) = 8
arr3D(0, 2, 2) = 9
arr3D(1, 2, 2) = 9
arr3D(2, 2, 2) = 9

ReDim arr3D(2, 2, 2)
arr3D(0, 0, 0) = "000"
arr3D(1, 0, 0) = "100"
arr3D(2, 0, 0) = "200"
arr3D(0, 1, 0) = "010"
arr3D(1, 1, 0) = "110"
arr3D(2, 1, 0) = "210"
arr3D(0, 2, 0) = "020"
arr3D(1, 2, 0) = "120"
arr3D(2, 2, 0) = "220"
arr3D(0, 0, 1) = "001"
arr3D(1, 0, 1) = "101"
arr3D(2, 0, 1) = "201"
arr3D(0, 1, 1) = "011"
arr3D(1, 1, 1) = "111"
arr3D(2, 1, 1) = "211"
arr3D(0, 2, 1) = "021"
arr3D(1, 2, 1) = "121"
arr3D(2, 2, 1) = "221"
arr3D(0, 0, 2) = "001"
arr3D(1, 0, 2) = "102"
arr3D(2, 0, 2) = "202"
arr3D(0, 1, 2) = "012"
arr3D(1, 1, 2) = "112"
arr3D(2, 1, 2) = "212"
arr3D(0, 2, 2) = "022"
arr3D(1, 2, 2) = "122"
arr3D(2, 2, 2) = "222"

' Here is function call
ret = ArraySlice(arr3D, 3, 1)
End If
1
我很感激你所付出的努力，但你觉得能不能找到一种通用的方法？我特别需要一种可以扩展到任意维度而不需要手动编码的方法。 - Blackhawk
好的，我稍后会尝试。 - Adisak Anusornsrirung
你能给我一个4D及以上维度的例子吗？ - Adisak Anusornsrirung
所以你打算将所有情况硬编码@AdisakAnusornsrirung - 但是OP [不希望这样做] (https://dev59.com/RI7ea4cB1Zd3GeqPH_N3#g50UoYgBc1ULPQZFCmDz)。 - GSerg
我的函数返回的是数组而不是单个数字。除非你在参数arr中输入了一个数组。 - Adisak Anusornsrirung
1

现在我写了所有这些并意识到您需要一个类似的元素设置器（基于SafeArrayPutElement而不是SafeArrayGetElement）和一个通用的数组创建例程，我在考虑是否硬编码所有60个情况实际上是一件坏事。

原因是VBA数组中最多可以有60个维度，并且硬编码60个情况并不困难。

我甚至没有手动输入此代码，而是使用了一些Excel公式来生成它：

Public Function GetArrayElement(ByRef arr As Variant, ParamArray indices()) As Variant
  Dim count As Long, lb As Long

  lb = LBound(indices)
  count = UBound(indices) - lb + 1

  Select Case count
  Case 1: GetArrayElement = arr(indices(lb))
  Case 2: GetArrayElement = arr(indices(lb), indices(lb + 1))
    ....
  Case Else
    Err.Raise 5, , "There can be no more than 60 dimensions"
  End Select

End Function

Public Sub SetArrayElement(ByRef arr As Variant, ByRef value As Variant, ParamArray indices())
  Dim count As Long, lb As Long

  lb = LBound(indices)
  count = UBound(indices) - lb + 1

  Select Case count
  Case 1: arr(indices(lb)) = value
  Case 2: arr(indices(lb), indices(lb + 1)) = value
    ....
  Case Else
    Err.Raise 5, , "There can be no more than 60 dimensions"
  End Select
End Sub

很不幸，这段内容比帖子允许的长度多两倍，因此这里有完整版本的链接：http://pastebin.com/KVqV3vyU

我想尽可能避免手写60个案例 :P 我已经完全忘记了oleaut32的SafeArray函数 - 我正在尝试使用SafeArrayCreateEx进行实验，以查明内存管理是否会阻止我即时创建一个数组，将其返回到Variant中，然后使用您在其他答案中提供的函数。 - Blackhawk
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接