指向存储为集合/字典项目VBA的数组
使用变体数组，其中每个元素是一个双数组，我能够做到以下几点：
Public Declare PtrSafe Sub CopyMemoryArray Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination() As Any, ByRef Source As Any, ByVal Length As Long) Sub test() Dim vntArr() as Variant Dim A() as Double Dim B() as Double Redim vntArr(1 to 10) Redim A(1 to 100, 1 to 200) vntArr(1) = A CopyMemoryArray B, ByVal VarPtr(vntArr(1)) + 8, PTR_LENGTH '4 or 8 'Do something ZeroMemoryArray B, PTR_LENGTH End Sub A和B将指向内存中的同一个块。 （设置W = vntArr（1）创build一个副本。对于非常大的数组，我想避免这种情况。）
我正在尝试做同样的事情，但collections：
Sub test() Dim col as Collection Dim A() as Double Dim B() as Double Set col = New Collection col.Add A, "A" CopyMemoryArray B, ByVal VarPtr(col("A")) + 8, PTR_LENGTH '4 or 8 'Do something ZeroMemoryArray B, PTR_LENGTH End Sub
这种工作，但由于某种原因，由col（“A”）返回的安全数组结构（包装在Variant数据types中，类似于上面的变体数组）只包含一些外部属性，如维数和边界不清晰，但是指向pvData本身的指针是空的，所以CopyMemoryArray调用导致崩溃。 （设置B = COL（“A”）正常工作）。与Scripting.Dictionary相同的情况。
有人知道这里发生了什么？ 
编辑
#If Win64 Then Public Const PTR_LENGTH As Long = 8 #Else Public Const PTR_LENGTH As Long = 4 #End If Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) Private Const VT_BYREF As Long = &H4000& Private Const S_OK As Long = &H0& Private Function pArrPtr(ByRef arr As Variant) As LongPtr Dim vt As Integer CopyMemory vt, arr, 2 If (vt And vbArray) <> vbArray Then Err.Raise 5, , "Variant must contain an array" End If If (vt And VT_BYREF) = VT_BYREF Then CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH CopyMemory pArrPtr, ByVal pArrPtr, PTR_LENGTH Else CopyMemory pArrPtr, ByVal VarPtr(arr) + 8, PTR_LENGTH End If End Function Private Function GetPointerToData(ByRef arr As Variant) As LongPtr Dim pvDataOffset As Long #If Win64 Then pvDataOffset = 16 '4 extra unused bytes on 64bit machines #Else pvDataOffset = 12 #End If CopyMemory GetPointerToData, ByVal pArrPtr(arr) + pvDataOffset, PTR_LENGTH End Function Sub CollectionWorks() Dim A(1 To 100, 1 To 50) As Double A(3, 1) = 42 Dim c As Collection Set c = New Collection c.Add A, "A" Dim ActualPointer As LongPtr ActualPointer = GetPointerToData(c("A")) Dim r As Double CopyMemory r, ByVal ActualPointer + (0 + 2) * 8, 8 MsgBox r 'Displays 42 End Sub
VB旨在隐藏复杂性。 通常这会产生非常简单和直观的代码，有时不会。
一个VARIANT可以包含一个非VARIANT数据的数组没有问题，比如一个Double S的数组。 但是当你尝试从VB访问这个数组时，你并没有得到一个原始的Double就像它实际上存储的是blob，你将它包装在一个临时的Variant ，在访问的时候构造，特别是不会让你感到惊讶事实上，一个声明As Variant的数组突然产生一个As Double的值。 在这个例子中你可以看到：
Sub NoRawDoubles() Dim A(1 To 100, 1 To 50) As Double Dim A_wrapper As Variant A_wrapper = A Debug.Print VarPtr(A(1, 1)), VarPtr(A_wrapper(1, 1)) Debug.Print VarPtr(A(3, 3)), VarPtr(A_wrapper(3, 3)) Debug.Print VarPtr(A(5, 5)), VarPtr(A_wrapper(5, 5)) End Sub
在我的电脑上，结果是：
88202488 1635820 88204104 1635820 88205720 1635820
来自A元素实际上是不同的，并且位于它们应该在数组内的存储器中，每个元素大小为8个字节，而A_wrapper “元素”实际上是相同的“元素” – 重复三次的地址是地址临时Variant大小为16个字节，用于存放数组元素，编译器决定重用。
这就是为什么以这种方式返回的数组元素不能用于指针运算。
集合本身不会增加任何问题。 这是事实上，收集必须包装它存储在一个Variant的数据，弄乱了它。 在将数组存储在Variant中的任何其他位置时也会发生这种情况。
为了得到适合于指针算术的实际解包数据指针，你需要从Variant查询SAFEARRAY*指针，它可以用一个或两个间接级别来存储，并从那里取数据指针。
在以前的例子的基础上，对于那个天真的非x64兼容的代码将是：
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 Const VT_BYREF As Long = &H4000& 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 Private Function GetPointerToData(ByRef arr As Variant) As Long GetMem4 pArrPtr(arr) + 12, VarPtr(GetPointerToData) End Function
然后可以在下面的非x64兼容的方式使用：
Sub CollectionWorks() Dim A(1 To 100, 1 To 50) As Double A(3, 1) = 42 Dim c As Collection Set c = New Collection c.Add A, "A" Dim ActualPointer As Long ActualPointer = GetPointerToData(c("A")) Dim r As Double GetMem4 ActualPointer + (0 + 2) * 8, VarPtr(r) GetMem4 ActualPointer + (0 + 2) * 8 + 4, VarPtr(r) + 4 MsgBox r 'Displays 42 End Sub
请注意，我不确定c("A")每次都会返回相同的实际数据，而不是根据需要进行复制，因此可能不会build议以这种方式caching指针，并且您最好先保存c("A")写入一个variables，然后调用GetPointerToData 。
显然这应该重写为使用LongPtr和CopyMemory ，明天我可能会这样做，但是你明白了。
如果将两个基本variables视为Variant，则更容易。
Option Explicit #If Vba7 Then Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte) #Else Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte) #End If Sub test() Dim col As Variant Dim B As Variant Dim A() As Double ReDim A(1 To 100, 1 To 200) A(1, 1) = 42 Set col = New Collection col.Add A, "A" Debug.Print col("A")(1, 1) CopyMemory B, col, 16 Debug.Print B("A")(1, 1) FillMemory B, 16, 0 End Sub
另请参阅这些有用的链接
部分数组参考
在VBA中复制数组引用
如何在Excel VBA中切片数组？