Solución:
VBA admite punteros, pero solo de forma muy limitada y principalmente para su uso con funciones API que los requieran (a través de VarPtr, StrPtr y ObjPtr). Puede hacer un poco de piratería para obtener la dirección base del área de memoria de una matriz. VBA implementa matrices como estructuras SAFEARRAY, por lo que la primera parte complicada es obtener la dirección de memoria del área de datos. La única forma que he encontrado para hacer esto es dejando que el tiempo de ejecución encuadre la matriz en una VARIANTE y luego separándola:
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
La segunda parte complicada es que VBA no tiene un método nativo para desreferenciar punteros, por lo que necesitará otra función auxiliar para hacer eso:
Public Function DerefDouble(pData As Long) As Double
Dim retVal As Double
CopyMemory retVal, ByVal pData, LenB(retVal)
DerefDouble = retVal
End Function
Entonces puede usar el puntero como lo haría en 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
Si esto es o no un buena idea o es mejor que lo que estás haciendo ahora se deja como ejercicio para el lector.
Podrías hacer algo como esto:
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
Por ejemplo:
Si 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
Luego, el siguiente código aplica estas dos funciones a dos matrices:
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
En Editar: Aquí hay una versión más complicada que permite pasar parámetros opcionales. Lo saqué a 2 parámetros opcionales, pero se extiende fácilmente a más:
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
Entonces, si define algo como:
Function Add(x As Variant, y As Variant) As Variant
Add = x + y
End Function
la llamada ArrayMap "Add", Vals, 2 agregará 2 a todo en la matriz.
En edición adicional: Variación sobre un tema. Debería explicarse por sí mismo:
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 "+", "-", "*", "https://foroayuda.es/", 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 "https://foroayuda.es/":
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
Entonces, por ejemplo, ArrayMap A, "+", 1 agregará 1 a todo en la matriz.
Para agregar a estas respuestas, encontré una forma realmente agradable (creo) de punteros de DeReference:
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
Encuentro que estos son absolutamente encantadores de usar y hacen que trabajar con punteros sea mucho más sencillo. He aquí un ejemplo sencillo:
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