A good substitute for references/pointers in VBA?
Solution 1
VBA supports pointers, but only to a very limited extent and mostly for use with API functions that require them (via VarPtr, StrPtr, and ObjPtr). You can do a little bit of hackery to get the base address of an array's memory area. VBA implements arrays as SAFEARRAY structures, so the first tricky part is getting the memory address of the data area. The only way I've found to do this is by letting the runtime box the array in a VARIANT and then pulling it apart:
Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, _
ByVal length As Long)
Private Const VT_BY_REF = &H4000&
Public Function GetBaseAddress(vb_array As Variant) As Long
Dim vtype As Integer
'First 2 bytes are the VARENUM.
CopyMemory vtype, vb_array, 2
Dim lp As Long
'Get the data pointer.
CopyMemory lp, ByVal VarPtr(vb_array) + 8, 4
'Make sure the VARENUM is a pointer.
If (vtype And VT_BY_REF) <> 0 Then
'Dereference it for the variant data address.
CopyMemory lp, ByVal lp, 4
'Read the SAFEARRAY data pointer.
Dim address As Long
CopyMemory address, ByVal lp, 16
GetBaseAddress = address
End If
End Function
The second tricky part is that VBA doesn't have a native method to dereference pointers, so you'll need another helper function to do that:
Public Function DerefDouble(pData As Long) As Double
Dim retVal As Double
CopyMemory retVal, ByVal pData, LenB(retVal)
DerefDouble = retVal
End Function
Then you can use the pointer just like you would in C:
Private Sub Wheeeeee()
Dim foo(3) As Double
foo(0) = 1.1
foo(1) = 2.2
foo(2) = 3.3
foo(3) = 4.4
Dim pArray As Long
pArray = GetBaseAddress(foo)
Debug.Print DerefDouble(pArray) 'Element 0
Debug.Print DerefDouble(pArray + 16) 'Element 2
End Sub
Whether or not this is a good idea or is better than what you're doing now is left as an exercise for the reader.
Solution 2
You could do something like this:
Sub ArrayMap(f As String, A As Variant)
'applies function with name f to
'every element in the 2-dimensional array A
Dim i As Long, j As Long
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
A(i, j) = Application.Run(f, A(i, j))
Next j
Next i
End Sub
For example:
If you define:
Function Increment(x As Variant) As Variant
Increment = x + 1
End Function
Function TimesTwo(x As Variant) As Variant
TimesTwo = 2 * x
End Function
Then the following code applies these two functions to two arrays:
Sub test()
Dim Vals As Variant
Vals = Range("A1:C3").Value
ArrayMap "Increment", Vals
Range("A1:C3").Value = Vals
Vals = Range("D1:F3").Value
ArrayMap "TimesTwo", Vals
Range("D1:F3").Value = Vals
End Sub
On Edit: Here is a more involved version that allows optional parameters to be passed. I took it out to 2 optional parameters, but it is easily extended to more:
Sub ArrayMap(f As String, A As Variant, ParamArray args() As Variant)
'applies function with name f to
'every element in the 2-dimensional array A
'up to two additional arguments to f can be passed
Dim i As Long, j As Long
Select Case UBound(args)
Case -1:
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
A(i, j) = Application.Run(f, A(i, j))
Next j
Next i
Case 0:
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
A(i, j) = Application.Run(f, A(i, j), args(0))
Next j
Next i
Case 1:
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
A(i, j) = Application.Run(f, A(i, j), args(0), args(1))
Next j
Next i
End Select
End Sub
Then if you define something like:
Function Add(x As Variant, y As Variant) As Variant
Add = x + y
End Function
the call ArrayMap "Add", Vals, 2 will add 2 to everything in the array.
On Further Edit: Variation on a theme. Should be self explanatory:
Sub ArrayMap(A As Variant, f As Variant, Optional arg As Variant)
'applies operation or function with name f to
'every element in the 2-dimensional array A
'if f is "+", "-", "*", "/", or "^", arg is the second argument and is required
'if f is a function, the second argument is passed if present
Dim i As Long, j As Long
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
Select Case f:
Case "+":
A(i, j) = A(i, j) + arg
Case "-":
A(i, j) = A(i, j) - arg
Case "*":
A(i, j) = A(i, j) * arg
Case "/":
A(i, j) = A(i, j) / arg
Case "^":
A(i, j) = A(i, j) ^ arg
Case Else:
If IsMissing(arg) Then
A(i, j) = Application.Run(f, A(i, j))
Else
A(i, j) = Application.Run(f, A(i, j), arg)
End If
End Select
Next j
Next i
End Sub
Then, for example, ArrayMap A, "+", 1 will add 1 to everything in the array.
Solution 3
To add to these answers, I've found a really nice (I think) way to DeReference pointers:
Option Explicit
Private Enum BOOL
API_FALSE = 0
'Use NOT (result = API_FALSE) for API_TRUE, as TRUE is just non-zero
End Enum
Private Enum VirtualProtectFlags 'See Memory Protection constants: https://docs.microsoft.com/en-gb/windows/win32/memory/memory-protection-constants
PAGE_EXECUTE_READWRITE = &H40
End Enum
#If Win64 Then 'To decide whether to use 8 or 4 bytes per chunk of memory
Private Declare Function GetMem Lib "msvbvm60" Alias "GetMem8" (ByRef src As Any, ByRef dest As Any) As Long
#Else
Private Declare Function GetMem Lib "msvbvm60" Alias "GetMem4" (ByRef src As Any, ByRef dest As Any) As Long
#End If
#If VBA7 Then 'for LongPtr
Private Declare Function VirtualProtect Lib "kernel32" (ByRef location As Any, ByVal numberOfBytes As Long, ByVal newProtectionFlags As VirtualProtectFlags, ByVal lpOldProtectionFlags As LongPtr) As BOOL
#Else
Private Declare Function VirtualProtect Lib "kernel32" (ByRef location As Any, ByVal numberOfBytes As Long, ByVal newProtectionFlags As VirtualProtectFlags, ByVal lpOldProtectionFlags As LongPtr) As BOOL
#End If
#If VBA7 Then
Public Property Let DeRef(ByVal address As LongPtr, ByVal value As LongPtr)
'unprotect memory for writing
Dim oldProtectVal As VirtualProtectFlags
If VirtualProtect(ByVal address, LenB(value), PAGE_EXECUTE_READWRITE, VarPtr(oldProtectVal)) = API_FALSE Then
Err.Raise 5, Description:="That address is protected memory which cannot be accessed"
Else
GetMem value, ByVal address
End If
End Property
Public Property Get DeRef(ByVal address As LongPtr) As LongPtr
GetMem ByVal address, DeRef
End Property
#Else
Public Property Let DeRef(ByVal address As Long, ByVal value As Long)
'unprotect memory for writing
Dim oldProtectVal As VirtualProtectFlags
If VirtualProtect(ByVal address, LenB(value), PAGE_EXECUTE_READWRITE, VarPtr(oldProtectVal)) = API_FALSE Then
Err.Raise 5, Description:="That address is protected memory which cannot be accessed"
Else
GetMem value, ByVal address
End If
End Property
Public Property Get DeRef(ByVal address As Long) As Long
GetMem ByVal address, DeRef
End Property
#End If
I'm finding these are absolutely lovely to use and make working with pointers much more straightforward. Here's a simple example:
Public Sub test()
Dim a As Long, b As Long
a = 5
b = 6
Dim a_address As LongPtr
a_address = VarPtr(a)
Dim b_address As LongPtr
b_address = VarPtr(b)
DeRef(a_address) = DeRef(b_address) 'the value at &a = the value at &b
Debug.Assert a = b 'succeeds
End Sub
Solution 4
Unfortunately += is not supported in VBA, but here are few alternatives ( I shortened the lngDimension to d ) :
x = i * d0 + j * d1 + k * d2
y = l * d3 + m * d4
dblMyArray(x,y) = dblMyArray(x,y) + 1
or 5 dimensions
Dim dblMyArray(d0, d1, d2, d3, d4) As Double
dblMyArray(i,j,k,l,m) = dblMyArray(i,j,k,l,m) + 1
or this 1 dimension monster (that I probably got wrong)
Dim dblMyArray(d0 * d1 * d2 * d3 * d4) As Double ' only one dimension
For i = 0 to d0 * d1 * d2 * d3 * d4 Step d1 * d2 * d3 * d4
For j = i to d1 * d2 * d3 * d4 Step d2 * d3 * d4
For k = j to d2 * d3 * d4 Step d3 * d4
For l = k to d3 * d4 Step d4
For m = l to d4 Step 1
dblMyArray(m) = dblMyArray(m) + 1
Next m
Next l
Next k
Next j
Next i
or maybe jagged arrays
Dim MyArray , subArray ' As Variant
MyArray = Array( Array( 1, 2, 3 ), Array( 4, 5, 6 ), Array( 7, 8, 9 ) )
' access like MyArray(x)(y) instead of MyArray(x, y)
For Each subArray In MyArray
For Each item In subArray
item = item + 1 ' not sure if it works this way instead of subArray(i)
Next
Next
Comments
-
z32a7ul over 1 year
Can you recommend me a good substitute for reference or pointer types in VBA? I have been struggling for long with expressions like this:
dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) = dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) + 1If I wanted to accumulate values in a multidimensional array in e.g. C++, I could write this:
double& rElement = dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ]; rElement += 1;or
double* pElement = &dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ]; *pElement += 1;I am looking for something like this.
I don't want to repeat the element on the right side of the assignment and I don't want to call a function with ByRef arguments because that would make the maintenance of the code much more difficult.
Any ideas?
-
z32a7ul over 7 yearsThanks, Vincent G, but I would like it without function call. The operation is not always addition and I don't like jumping to one line long functions in the editor or the debugger.
-
John Coleman over 7 yearsImpressive hackery. +1 (though -- I don't think that actually using this would be a very good idea.) -
Comintern over 7 yearsNow we're cookin' with a VBA analogue of function pointers. +1