通过一些内存技巧,您可以将多维数组视为一维数组。你会需要库内存 https://github.com/cristianbuse/VBA-MemoryTools/blob/master/src/LibMemory.bas:
Option Explicit
Public Type FAKE_ARRAY
sArr As SAFEARRAY_1D
fakeArrPtr As LongPtr
values As Variant
End Type
Public Sub ArrayToFakeArray(ByRef arr As Variant, ByRef fakeArray As FAKE_ARRAY)
Dim aptr As LongPtr: aptr = ArrPtr(arr) 'Will throw if not array
Dim i As Long
'
With fakeArray
.fakeArrPtr = VarPtr(.sArr)
MemCopy .fakeArrPtr, aptr, LenB(.sArr)
With .sArr.rgsabound0
.cElements = 1
For i = 1 To fakeArray.sArr.cDims
.cElements = .cElements * (UBound(arr, i) - LBound(arr, i) + 1)
Next i
End With
.sArr.cDims = 1
.values = VarPtr(.fakeArrPtr)
MemInt(VarPtr(.values)) = VarType(arr) Or VT_BYREF
End With
End Sub
快速测试:
Sub Test()
Dim arr(2, 3, 2) As Variant
Dim i As Long, j As Long, k As Long
Dim m As Long
Dim v As Variant
'
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
For k = LBound(arr, 3) To UBound(arr, 3)
arr(i, j, k) = m
m = m + 1
Next k
Next j
Next i
'
Dim temp As FAKE_ARRAY: ArrayToFakeArray arr, temp
'
Dim arr2(1, 1) As Double
arr2(1, 1) = 17.55
'
Dim temp2 As FAKE_ARRAY: ArrayToFakeArray arr2, temp2
'
Debug.Print temp.values(0)
Debug.Print temp.values(4) '15
Debug.Print temp.values(35)
'
arr(1, 1, 0) = "AAA"
Debug.Print temp.values(4) 'AAA
Debug.Print temp2.values(3)
End Sub
Edit #1
这是对OP在评论部分提出的一系列有趣问题的回应。不仅响应太长,而且它绝对应该是答案的一部分。
如果我理解正确的话,最后一行将数组类型设置为与 arr 相同,但假数组的所有元素都指向原始 ByRef?
当复制 SAFEARRAY 结构时,我们也复制pvData
指向实际数据的指针。假数组指向内存中的相同数据,因此我们欺骗数组处理代码直接读取该数据(而不是 ByRef)。但是,我们需要在values
避免两次释放相同内存而导致崩溃的变体。但到目前为止,没有什么是 ByRef ——只有 2 个数组变量指向相同的数据。
是否存在原始数据已经是 ByRef (VARIANTARGS 的参数数组?)的情况,而这不起作用?
如果原始数据具有 ByRef 成员(VARIANTARGS 的参数数组),则只有当我们使用类似以下内容时才会发生这种情况CloneParamArray
方法,因为否则 VB 不允许传递 param 数组,至少本地不允许。在这种情况下,通过假数组访问 ByRef 成员只能通过可以接收此类成员 ByRef 的实用程序函数正确完成。
Example:
Sub Test()
Dim t As Long: t = 5
ToParam 1, 2, 3, 4, t
Debug.Print t
End Sub
Public Sub ToParam(ParamArray args() As Variant)
Dim arr() As Variant
CloneParamArray args(0), UBound(args) + 1, arr
Dim temp As FAKE_ARRAY: ArrayToFakeArray arr, temp
Debug.Print arr(4)
' Debug.Print temp.values(4) 'Err 458 - type not supported
PrintVar temp.values(4)
args(4) = 7
Debug.Print arr(4)
PrintVar temp.values(4)
LetByRef(temp.values(4)) = 9
Debug.Print arr(4)
PrintVar temp.values(4)
End Sub
Private Function PrintVar(ByRef v As Variant)
Debug.Print v
End Function
Private Property Let LetByRef(ByRef vLeft As Variant, ByVal vRight As Variant)
vLeft = vRight
End Property
如果一个人使用CloneParamArray
无论如何,人们应该意识到 ByRef 个人变体成员只能通过实用程序方法访问/更改,例如PrintVar
and LetByRef
或任何其他需要 ByRef Variant 作为参数的方法。
另外,为什么要采用数组 byref ?因为它是引用类型,所以 byval 不会进行浅复制,因此唯一的区别是现在您可以将 arr 设置为指向不同的数组吗?
因为我们不知道数组类型是什么(例如Long()
or Variant()
)那么当我们传递给ArrayToFakeArray
方法。传递包装数组ByVal
确实制作了副本,我们可以通过运行以下命令看到:
Option Explicit
Sub Test()
Dim arr() As Long
ReDim arr(0 To 1)
arr(0) = 12
arr(1) = 44
'
PassArr arr, arr
Debug.Print
Debug.Print arr(1) 'Prints 55
End Sub
Private Sub PassArr(ByVal arrByVal As Variant, ByRef arrByRef As Variant)
#If Win64 Then
Const dataOffset As Long = 16
#Else
Const dataOffset As Long = 12
#End If
Dim aPtrByVal As LongPtr: aPtrByVal = ArrPtr(arrByVal)
Dim aPtrByRef As LongPtr: aPtrByRef = ArrPtr(arrByRef)
Dim pvDataByVal As LongPtr: pvDataByVal = MemLongPtr(aPtrByVal + dataOffset)
Dim pvDataByRef As LongPtr: pvDataByRef = MemLongPtr(aPtrByRef + dataOffset)
'
Debug.Print "ByVal SAFEARRAY address:", aPtrByVal, "ByVal data address:", pvDataByVal
Debug.Print "ByRef SAFEARRAY address:", aPtrByRef, "ByRef data address:", pvDataByRef
'
Debug.Print MemLong(pvDataByVal + 4) 'Prints 44
Debug.Print MemLong(pvDataByRef + 4) 'Prints 44
'
arrByRef(1) = 55
'
Debug.Print MemLong(pvDataByVal + 4) 'Prints 44
Debug.Print MemLong(pvDataByRef + 4) 'Prints 55
'
arrByVal(1) = 77
'
Debug.Print MemLong(pvDataByVal + 4) 'Prints 77
Debug.Print MemLong(pvDataByRef + 4) 'Prints 55
End Sub
所以,我们需要传递包装后的数组ByRef
以便ArrPtr
返回 SAFEARRAY 结构的正确地址。