VBA中引用/指针的一个很好的替代品？

Question

你能推荐我在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参数调用函数,因为这会使代码的维护变得更加困难.

有任何想法吗？

Answer 1

VBA支持指针,但仅限于非常有限的范围,主要用于需要它们的API函数(通过VarPtr,StrPtr和ObjPtr).你可以做一些hackery来获取数组内存区的基地址.VBA将数组实现为SAFEARRAY结构,因此第一个棘手的部分是获取数据区的内存地址.我发现这样做的唯一方法是将运行时框放在VARIANT中,然后将其拉开:

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

第二个棘手的部分是VBA没有一个本地方法来取消引用指针,所以你需要另一个辅助函数来做到这一点:

Public Function DerefDouble(pData As Long) As Double
    Dim retVal As Double
    CopyMemory retVal, ByVal pData, LenB(retVal)
    DerefDouble = retVal
End Function

然后就像在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

无论这是一个好主意还是比你现在所做的更好,都留给读者练习.

Answer 2

你可以这样做：

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

编辑时：这是一个更复杂的版本，允许传递可选参数。我将其取出为 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。