在 VBA 中复制数组引用
Posted
技术标签:
【中文标题】在 VBA 中复制数组引用【英文标题】：Copy an array reference in VBA 【发布时间】：2013-05-01 18:07:02 【问题描述】：有没有办法在 VBA（或 VB6）中复制数组引用？
在 VBA 中，数组是值类型。将一个数组变量分配给另一个变量会复制整个数组。我想让两个数组变量指向同一个数组。有什么方法可以做到这一点，也许使用一些 API 内存函数和/或 VarPtr 函数，它实际上返回 VBA 中变量的地址？
Dim arr1(), arr2(), ref1 As LongPtr
arr1 = Array("A", "B", "C")
' Now I want to make arr2 refer to the same array object as arr1
' If this was C#, simply assign, since in .NET arrays are reference types:
arr2 = arr1
' ...Or if arrays were COM objects:
Set arr2 = arr1
' VarPtr lets me get the address of arr1 like this:
ref1 = VarPtr(arr1)
' ... But I don't know of a way to *set* address of arr2.
顺便说一句，通过将同一个数组变量ByRef 传递给一个方法的多个参数，可以获得对同一个数组的多个引用：
Sub DuplicateRefs(ByRef Arr1() As String, ByRef Arr2() As String)
Arr2(0) = "Hello"
Debug.Print Arr1(0)
End Sub
Dim arrSource(2) As String
arrSource(0) = "Blah"
' This will print 'Hello', because inside DuplicateRefs, both variables
' point to the same array. That is, VarPtr(Arr1) == VarPtr(Arr2)
Call DuplicateRefs(arrSource, arrSource)
但这仍然不允许人们简单地制造与现有参考相同范围的新参考。
【问题讨论】：
虽然我不知道您的问题的答案，但我对解决方案非常感兴趣...您可以创建一个单例类来保存您的数组并通过该类返回引用吗？跨度> 不。从函数或属性返回数组也按值操作——返回数组的新副本。这实际上是我要解决的真正问题。 【参考方案1】：是的，你可以，如果两个变量都是 Variant 类型。
原因如下：Variant 类型本身就是一个包装器。 Variant 的实际位内容为 16 个字节。第一个字节表示当前存储的实际数据类型。该值与 VbVarType 枚举完全对应。即，如果 Variant 当前持有 Long 值，则第一个字节将是 0x03，即 vbLong 的值。第二个字节包含一些位标志。例如，如果变量包含一个数组，则该字节中0x20 的位将被设置。
剩余 14 个字节的使用取决于所存储的数据类型。对于任何数组类型，它都包含数组的地址。
这意味着如果您使用RtlMoveMemory 直接覆盖一个变体的值，您实际上已经覆盖了一个数组的引用。这确实有效！
有一个警告：当数组变量超出范围时，VB 运行时将回收实际数组元素包含的内存。当您通过我刚刚描述的 Variant CopyMemory 技术手动复制数组引用时，结果是当两个变体超出范围时，运行时将尝试回收相同的内存两次，并且程序将崩溃。为避免这种情况，您需要在变量超出范围之前通过再次覆盖变体（例如使用 0）手动“擦除”除一个引用之外的所有引用。
示例 1：这可行，但一旦两个变量都超出范围（子退出时）就会崩溃
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub CopyArrayRef_Bad()
Dim v1 As Variant, v2 As Variant
v1 = Array(1, 2, 3)
CopyMemory v2, v1, 16
' Proof:
v2(1) = "Hello"
Debug.Print Join(v1, ", ")
' ... and now the program will crash
End Sub
示例 2：通过仔细清理，您可以侥幸成功！
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)
Sub CopyArrayRef_Good()
Dim v1 As Variant, v2 As Variant
v1 = Array(1, 2, 3)
CopyMemory v2, v1, 16
' Proof:
v2(1) = "Hello"
Debug.Print Join(v1, ", ")
' Clean up:
FillMemory v2, 16, 0
' All good!
End Sub
【讨论】：
+1 与此类似，非变量数组是一个 SAFEARRAY 结构，它还包含各种成员和指向其数据的指针，您可以可能复制和覆盖。 （vb 运行时 varptrarray() 导出返回一个指向 vba 数组 SAFEARRAY 标头的指针） @AlexK。杰出的！我不知道Automation array manipulation API。我推断 VB[A] 运行时使用这个 API 来实现它的数组，所以我突然对一些 VB 运行时内部结构有了清晰的认识，这是我一直在寻找的。span> 【参考方案2】：这个解决方案怎么样...
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Public Sub TRIAL()
Dim myValueType As Integer
Dim mySecondValueType As Integer
Dim memPTR As Long
myValueType = 67
memPTR = VarPtr(mySecondValueType)
CopyMemory ByVal memPTR, myValueType, 2
Debug.Print mySecondValueType
End Sub
这个概念来自 CodeProject 的一篇文章here
【讨论】：
这仍然是复制值，而不是引用。如果引用被成功复制，那么设置mySecondValueType = 42 也会改变myValueType 的值。【参考方案3】：
虽然您可以使用CopyMemory 和FillMemory，但我强烈建议您永远不要将这些引用保留太久。作为一个例子，我根据这个确切的原则制作了stdRefArray 类，不要使用这个代码！继续阅读以了解原因...：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'I STRONGLY RECOMMEND AGAINST USING THIS CLASS. SEE WHY HERE:
'https://***.com/a/63838676/6302131
'Status WIP
'High level wrapper around 2d array.
#Const DEBUG_PERF = False
'Variables for pData
Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)
Public Data As Variant
Private Const VARIANT_SIZE As Long = 16
Public Function Create(ByRef Data As Variant) As stdRefArray
Set Create = New stdRefArray
Call Create.Init(Data)
End Function
Public Sub Init(ByRef DataIn As Variant)
'Create direct reference to array:
CopyMemory Data, DataIn, VARIANT_SIZE
End Sub
Private Sub Class_Terminate()
'Clean up array reference
FillMemory Data, VARIANT_SIZE, 0
End Sub
Public Function GetData(ByVal iRow as long, ByVal iCol as long) as Variant
Attribute GetData.VB_UserMemID=0
GetData = GetData(iRow,iCol)
End Function
我最初使用这个类的想法是做如下的事情：
Cars.FindCar(...).GetDoor(1).Color = Rgb(255,0,0)
其中 Car 类具有对 Cars 数组的引用，并且与 Door 类类似地存储对 Cars 数组的引用，从而允许“即时”设置器直接访问初始数据源。
这很好用！ 但是...
我在调试时遇到了很多问题。如果您处于调试模式，在 Door 类中，在颜色设置器中，如果您对需要重新编译的结构进行更改 I.E.更改dimed 变量的名称、更改方法/属性的名称或更改它们的类型，Excel 将立即崩溃。当您单击 VBA 停止（方形）按钮时，也会发生类似的事情。不仅如此，从 Excel 中调试这些即时崩溃是非常令人讨厌的......
这使得上述代码确保您的代码库的其余部分也难以维护。这将增加修复的时间，导致很多挫折和制造。运行时节省的时间并不能证明解决问题所花费的时间是合理的。
如果您确实创建了这些数组引用，请确保您将它们的生命保持在非常短的时间内，并在调试问题之间充分评论。
注意：如果有人能找到解决此崩溃问题的方法（即在 VBA 崩溃之前正确清理堆栈，我会非常感兴趣！）
我强烈建议您使用这样的简单类：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "stdRefArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Status WIP
'High level wrapper around arrays
Public Event Changed(ByVal iRow As Long, ByVal iCol As Long, ByVal Value As Variant)
Public vData As Variant
Public Function Create(ByRef Data As Variant) As stdRefArray
Set Create = New stdRefArray
Call Create.Init(Data)
End Function
Public Sub Init(ByRef Data As Variant)
'Slow, but a stable reference
vData = Data
End Sub
Public Property Get Data(Optional ByVal iRow As Long = -1, Optional ByVal iCol As Long = -1) As Variant
Attribute Data.VB_UserMemId = 0
If iRow = -1 And iCol = -1 Then
CopyVariant Data, vData
ElseIf iRow <> -1 And iCol <> -1 Then
CopyVariant Data, vData(iRow, iCol)
Else
stdError.Raise "stdRefArray::Data() - Invalid use of Data", vbCritical
End If
End Property
Public Property Let Data(ByVal iRow As Long, ByVal iCol As Long, Value As Variant)
vData(iRow, iCol) = Value
RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Set Data(ByVal iRow As Long, ByVal iCol As Long, Value As Object)
Set vData(iRow, iCol) = Value
RaiseEvent Changed(iRow, iCol, Value)
End Property
Public Property Get BoundLower(ByVal iDimension As Long) As Long
BoundLower = LBound(vData, iDimension)
End Property
Public Property Get BoundUpper(ByVal iDimension As Long) As Long
BoundUpper = UBound(vData, iDimension)
End Property
Private Function CopyVariant(ByRef dest As Variant, ByVal src As Variant)
If IsObject(src) Then
Set dest = src
Else
dest = src
End If
End Function
我添加了一些有助于绑定的额外步骤。你仍然会失去很多原生行为，但是这是最安全的赌注，也是最容易维护的赌注。这也是在不使用集合的情况下获得类似集合功能的最快方法。
用法，Car.cls：
Private WithEvents pInventory as stdRefArray
Public Function Create(ByRef arrInventory as variant)
Set Create = new Car
Set Create.pInventory = stdRefArray.Create(arrInventory)
End Function
Public Function GetDoor(ByVal iRow as long) as Door
Set GetDoor = new Door
GetDoor.init(pInventory,iRow)
End Function
Door.cls
Private pArray as stdRefArray
Private pRow as long
Private Const iColorColumn = 10
Sub Init(ByVal array as stdRefArray, ByVal iRow as long)
set pArray = array
pRow = iRow
End Sub
Public Property Get Color() as long
Color = pArray(pRow,iColorColumn)
End Property
Public Property Let Color(ByVal iNewColor as long)
pArray(pRow,iColorColumn) = iNewColor
End Property
这个例子可能不太好，但希望你能明白。
【讨论】：
【参考方案4】：您可以使用我的存储库VBA-MemoryTools 中名为GetArrayByRef 的方法。但是，如果您不想要额外的参考，您可以使用这个有限的、较慢的代码：
Option Explicit
#If Mac Then
#If VBA7 Then
Public Declare PtrSafe Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As LongPtr) As LongPtr
#Else
Public Declare Function CopyMemory Lib "/usr/lib/libc.dylib" Alias "memmove" (Destination As Any, Source As Any, ByVal Length As Long) As Long
#End If
#Else 'Windows
'https://msdn.microsoft.com/en-us/library/mt723419(v=vs.85).aspx
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#End If
Public Const VT_BYREF As Long = &H4000
#If Win64 Then
Public Const PTR_SIZE As Long = 8
#Else
Public Const PTR_SIZE As Long = 4
#End If
Public Function GetArrayByRef(ByRef arr As Variant) As Variant
If IsArray(arr) Then
GetArrayByRef = VarPtrArr(arr)
Dim vt As VbVarType: vt = VarType(arr) Or VT_BYREF
CopyMemory GetArrayByRef, vt, 2
Else
Err.Raise 5, "GetArrayByRef", "Array required"
End If
End Function
#If Win64 Then
Public Function VarPtrArr(ByRef arr As Variant) As LongLong
#Else
Public Function VarPtrArr(ByRef arr As Variant) As Long
#End If
Const vtArrByRef As Long = vbArray + VT_BYREF
Dim vt As VbVarType
CopyMemory vt, arr, 2
If (vt And vtArrByRef) = vtArrByRef Then
Const pArrayOffset As Long = 8
CopyMemory VarPtrArr, ByVal VarPtr(arr) + pArrayOffset, PTR_SIZE
Else
Err.Raise 5, "VarPtrArr", "Array required"
End If
End Function
快速测试：
Sub Demo()
Dim arr() As String
ReDim arr(1 To 2)
arr(1) = "AAA"
Dim v As Variant
v = GetArrayByRef(arr)
v(2) = "BBB"
Debug.Assert arr(2) = "BBB"
End Sub
它也很安全——你不必担心内存释放
【讨论】：
以上是关于在 VBA 中复制数组引用的主要内容，如果未能解决你的问题，请参考以下文章