你能否推荐我在VBA中很好地替代参考或指针类型？我一直在用这样的表达方式苦苦挣扎：
dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) = dblMyArray( i * lngDimension0 + j * lngDimension1 + k * lngDimension2, l * lngDimension3 + m * lngDimension4 ) + 1
如果我想在多维数组中累积值，例如C ++，我可以这样写：
double& rElement = dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ];
rElement += 1;
或
double* pElement = &dblMyArray[ i * lngDimension0 + j * lngDimension1 + k * lngDimension2 ][ l * lngDimension3 + m * lngDimension4 ];
*pElement += 1;
我正在寻找类似的东西。
我不想重复赋值右侧的元素，我不想用ByRef参数调用函数，因为这会使代码的维护变得更加困难。
有什么想法吗？
答案 0 :(得分：8)
VBA支持指针，但仅限于非常有限的范围，主要用于需要它们的API函数（通过VarPtr，StrPtr和ObjPtr）。你可以做一些hackery来获取数组内存区的基地址。 VBA将数组实现为SAFEARRAY结构，因此第一个棘手的部分是获取数据区的内存地址。我发现这样做的唯一方法是让运行时框将数组放在VARIANT中，然后将它拉开：
--insecure-registry第二个棘手的部分是VBA没有一个本地方法来取消引用指针，所以你需要另一个辅助函数来做到这一点：
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
然后你可以像使用C：
一样使用指针Public Function DerefDouble(pData As Long) As Double
Dim retVal As Double
CopyMemory retVal, ByVal pData, LenB(retVal)
DerefDouble = retVal
End Function
这是否是一个好主意，或者比你现在所做的更好，留给读者练习。
答案 1 :(得分：3)
你可以这样做：
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
例如：
如果你定义：
Function Increment(x As Variant) As Variant
Increment = x + 1
End Function
Function TimesTwo(x As Variant) As Variant
TimesTwo = 2 * x
End Function
然后，以下代码将这两个函数应用于两个数组：
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：这是一个更复杂的版本，允许传递可选参数。我把它拿出来给2个可选参数，但很容易扩展到更多：
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
然后，如果您定义类似：
Function Add(x As Variant, y As Variant) As Variant
Add = x + y
End Function
调用ArrayMap "Add", Vals, 2将为数组中的所有内容添加2。
进一步编辑：主题的变体。应该是自我解释的：
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
然后，例如，ArrayMap A, "+", 1将为数组中的所有内容添加1。
答案 2 :(得分：2)
要添加到这些答案中，我发现了一种非常好的（我认为）DeReference指针的方法：
inflater.inflate(R.layout.fragment_hadees, container, false);
我发现它们绝对好用，并且使指针的使用更加简单。这是一个简单的示例：
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
答案 3 :(得分：1)
不幸的是，VBA不支持+=，但这里有一些替代方案（我将lngDimension缩短为d）：
x = i * d0 + j * d1 + k * d2
y = l * d3 + m * d4
dblMyArray(x,y) = dblMyArray(x,y) + 1
或5维
Dim dblMyArray(d0, d1, d2, d3, d4) As Double
dblMyArray(i,j,k,l,m) = dblMyArray(i,j,k,l,m) + 1
或这个1维怪物（我可能错了）
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
或者可能是锯齿状阵列
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
答案 4 :(得分：0)
您可以使用带参考参数的子：
Sub Add2Var(ByRef variable As Double, ByVal value As Double)
variable = variable + value
End Sub
像这样使用：
Sub Test()
Dim da(1 To 2) As Double
Dim i As Long
For i = 1 To 2
da(i) = i * 1.1
Next i
Debug.print da(1), da(2)
Add2Var da(1), 10.1
Add2Var da(2), 22.1
Debug.print da(1), da(2)
End Sub