Question

在Excel VBA中，我可以使用RtlCopyMemory将2D安全变体数组中的每个元素移动到另一个变体SafeArray中，以使元素转置。

以下VBA代码段对此非常有效（假设变量具有适当的值）：

For i = 0 To TotalElems - 1
    CopyMemory ByVal ptrDest + i * LenElem, ByVal ptrSrc + (Elems1D * col + row) * LenElem, LenElem
    col = col + 1
    If col = Elems2D Then
        col = 0
        row = row + 1
    End If
Next

但是，我对执行速度感到失望。上面的代码段比仅使用VBA一次将值分配给第二个数组要慢大约五倍。

数组可能很大；他们可以有成千上万的元素。

我的猜测是，RtlCopyMemory的成千上万次通话很昂贵。

因此，我想测试是否将上述代码段移至C / C ++ DLL并调用一次（而不是数千次）是否可以消除瓶颈，甚至比直接在VBA中分配值还要快。

我对C / C ++极为生锈，但是可以做到以下几点。但这行不通。它的确返回“ 1”，并且Excel不会崩溃。但是目标数组中的值不受代码干扰。好像什么都没有发生。

long int __stdcall TransposeMemory(long *ptrDest, long *ptrSrc, long &LenElem, long &Elems1D, long &Elems2D, long &TotalElems) {

    long col = 0;
    long row = 0;

    for (long i = 0; i < TotalElems; i++) {

        memcpy (&ptrDest + (i * LenElem), &ptrSrc + (Elems1D * col + row) * LenElem, LenElem);

        col++;
        if (col == Elems2D) {
            col = 0;
            row++;
        }
    }

    return 1; 
}

在VBA中，我这样称呼它：

Result = TransposeMemory(array2(1, 1), array1(1, 1), LenElem, Elems1D, Elems2D, TotalElems)

以这种方式传递数组将为C / C ++ DLL函数提供指向每个数组中第一个元素的指针。所有数据都连续存储，每个元素的长度为16个字节。

你能告诉我我要去哪里了吗？

作为后续问题，哪种方法可以最快地完成此数据转换？

为帮助阐明数据布局，请想象一下Excel中行和列中的一系列单元格：

+---+---+---+
| a | e | i |
+---+---+---+
| b | f | j |
+---+---+---+
| c | g | k |
+---+---+---+
| d | h | l |
+---+---+---+

上面的2D数组有四行三列，Excel将以上面的模式将其显示在工作表上。

但是，VBA像这样从第一个元素开始连续存储值（每个元素的长度为16个字节）：

+---+
| a |
+---+
| b |
+---+
| c |
+---+
| d |
+---+
| e |
+---+
| f |
+---+
| g |
+---+
| h |
+---+
| i |
+---+
| j |
+---+
| k |
+---+
| l |
+---+

当数据转置正确时（此问题顶部的VBA代码段正是这样做的），Excel会像这样显示它们：

+---+---+---+---+
| a | b | c | d |
+---+---+---+---+
| e | f | g | h |
+---+---+---+---+
| i | j | k | l |
+---+---+---+---+

请注意，现在我们有三行四列。

VBA以此顺序将元素存储在转置数组中，这是我要实现的目标：

+---+
| a |
+---+
| e |
+---+
| i |
+---+
| b |
+---+
| f |
+---+
| j |
+---+
| c |
+---+
| g |
+---+
| k |
+---+
| d |
+---+
| h |
+---+
| l |
+---+

Answer 1

我发现RtlCopyMemory和RtlMoveMemory之间在Office 64位上存在非常强的性能差异，对于我无法分辨的Office 32位，但这可能仍然很重要。在许多论坛中，CopyMemory被定义为：

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)

此例程检查源和目标的重叠内存部分，并且似乎很多slower on Office 64 than on Office 32。要在两个VBA变量之间切换，您可以放心使用

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlCopyMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)

这可能会解决您的性能问题，因此您无需对C代码使用替代方法。

Answer 2

第二个答案：我们了解到Office在调用dll方面并不出色，所以为什么不利用索引速度相对较快这一事实呢？

下面的代码将数组a的数据复制到元素大小为variant（32位为16字节，64位为24字节）的大小相等的2D类型数组a1 ，将其转置到另一个类型为b1的数组，并将数据复制回a。之后，通过调整safearray结构来切换a的尺寸。请注意，这比将其复制到另一个数组b更好，因为变体可能包含字符串，其中只有指针存储在数组数据块中。如果使用RtlCopyMemory复制变体，则b的字符串指针指向相同的内存，并且在程序结尾处Excel尝试两次释放字符串，并且可能会崩溃。如果仅复制数值，那将是安全的。附加例程的速度与直接分配数字值的速度相当，但在字符串值方面的表现大大优于:-) 它解决了重新排列原始数组的问题。（仍然可以通过将a1的数据指针设置为a的原始值来提高速度，但这是内存错误的另一个潜在来源。）

Option Explicit

#If Win64 Then
    Const PTR_LEN = 8
    Const VAR_LEN = 24
#Else
    Const PTR_LEN = 4
    Const VAR_LEN = 16
#End If

Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlCopyMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
Private Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (hpvDest As Any, ByVal cbCopy As LongPtr)

Private Type SAFEARRAYBOUND
    cElements    As Long
    lLbound      As Long
End Type

Private Type SafeArray
    cDims        As Integer
    fFeatures    As Integer
    cbElements   As Long
    cLocks       As Long
    pvData       As LongPtr
    bounds(1 To 2) As SAFEARRAYBOUND
End Type

Type hh
    a(1 To VAR_LEN) As Byte
End Type


Sub TransposeVariantArrayInPlace(ByRef a As Variant)
    Dim ptrSA As LongPtr, SA As SafeArray, bound As SAFEARRAYBOUND
    Dim aPtr As LongPtr, a1Ptr As LongPtr, b1Ptr As LongPtr, a1() As hh, b1() As hh
    Dim j1 As Long, j2 As Long, j3 As Long, m As Long, n As Long, Totalsize As LongPtr

    'retrieve the pointer to the safearray
    ptrSA = VarPtr(a) + 8
    CopyMemory ptrSA, ByVal ptrSA, PTR_LEN

    'copy the safearray data
    CopyMemory SA, ByVal ptrSA, LenB(SA)
    ' Exit if not a 2D array
    If SA.cDims <> 2 Then Exit Sub

    ' generate typed arrays of equal dimensions
    m = SA.bounds(2).cElements
    n = SA.bounds(1).cElements
    ReDim a1(1 To m, 1 To n)
    ReDim b1(1 To n, 1 To m)

    ' retrieve pointers to array data
    aPtr = VarPtr(a(1, 1))
    a1Ptr = VarPtr(a1(1, 1))
    b1Ptr = VarPtr(b1(1, 1))

    Totalsize = m * n * VAR_LEN

    ' Copy the content of a to a1 and store the transposed array in b1
    CopyMemory ByVal a1Ptr, ByVal aPtr, Totalsize
    For j1 = 1 To m
        For j2 = 1 To n
            b1(j2, j1) = a1(j1, j2)
        Next
    Next

    ' write the transposed values back to a
    CopyMemory ByVal aPtr, ByVal b1Ptr, Totalsize

    ' change the dimensions of a in the safearray structure
    bound = SA.bounds(1)
    SA.bounds(1) = SA.bounds(2)
    SA.bounds(2) = bound
    CopyMemory ByVal ptrSA, SA, LenB(SA)

    ' important to empty the arrays in the case that string values have been assigned
    ' because Excel would try to free the space twice and might crash
    ZeroMemory ByVal a1Ptr, Totalsize
    ZeroMemory ByVal b1Ptr, Totalsize
End Sub

Function Transpose(ByRef a As Variant) As Variant
    Dim ptrSA As LongPtr, SA As SafeArray, bound As SAFEARRAYBOUND
    Dim b As Variant, j1 As Long, j2 As Long, m As Long, n As Long

    'retrieve the pointer to the safearray
    ptrSA = VarPtr(a) + 8
    CopyMemory ptrSA, ByVal ptrSA, PTR_LEN

    'copy the safearray data
    CopyMemory SA, ByVal ptrSA, LenB(SA)
    ' Exit if not a 2D array
    If SA.cDims <> 2 Then Exit Function

    ' generate typed arrays of equal dimensions
    m = SA.bounds(2).cElements
    n = SA.bounds(1).cElements
    ReDim b(1 To n, 1 To m)

    For j1 = 1 To m
        For j2 = 1 To n
            b(j2, j1) = a(j1, j2)
        Next
    Next

    Transpose = b

End Function

Sub TransposeComparison()
    Dim a, b As Variant
    Dim m As Long, n As Long, j1 As Long, j2 As Long, t1, t2, t3

    m = 2000
    n = 1000
    ReDim a(1 To m, 1 To n) As Variant

    'Filling the area with some test data
    For j1 = 1 To m
        For j2 = 1 To n
            a(j1, j2) = CLngLng(10 * j1 + j2)
            'a(j1, j2) = CLngLng(10 * j1 + j2) & "HH" ' for string assisnments
        Next
    Next

    t1 = Timer()

    ' classical indexing
    b = Transpose(a)

    t2 = Timer()

    TransposeVariantArrayInPlace a

    t3 = Timer()

    MsgBox t2 - t1 & " " & t3 - t2

End Sub

P.S .：为了便于阅读，我编辑了代码。请注意，必须将数组a声明为dim a或dim a as Variant，否则ReDim a(1 to m, 1 to n)可以工作，但是您需要另一个CopyMemory ptrSA, ByVal ptrSA, PTR_LEN才能检索safearray指针。

在C / C ++ DLL中通过Excel转置Elements 2D SafeArray

2 个答案: