Хорошая замена для ссылок/указателей в 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). Вы можете сделать немного хакера, чтобы получить базовый адрес области памяти массива. 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 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 

Answer 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 

На 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 ко всему в массиве.

Answer 4

К сожалению += не поддерживается в 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