VBA多维数组转一维数组

VBA 学习 2021-06-28

1879

在VBA中，join函数可以快速的将一个String类型的数组连接成一个字符串，用的还比较多。

但是这个函数只支持将一维的数组进行连接，如果碰到多维数组的情况，一般都是先用For循环将数组转换为一维的，然后再使用join函数。这样就造成不得不另外使用一个数组的内存空间来保存数据，同时还要进行For循环处理，浪费了时间和空间。

在数据类型Array中，我们知道了数组的底层结构，其中cDims就是指明数组维度的，那么，我们只需要通过修改内存中cDims的值，以及SafeArray中rgsabound记录的元素的个数，那么就可以实现将多维的数组转换为一维数组：

代码：

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Type SafeArrayBound
    cElements As Long '// 该维的长度
    lLbound   As Long '  该维的数组存取的下限，一般为0
End Type


Private Type SafeArray
    cDims      As Integer '  数组的维度
    fFeatures  As Integer '
    cbElements As Long ' / 数组元素的字节大小
    cLocksas   As Long '
    pvDataas   As Long ' // 数组的数据指针
    rgsabound() As SafeArrayBound
End Type


Sub TestToOneDim()
    Dim arr() As String
    ReDim arr(1, 2, 3) As String
    
    VBA.Randomize
    
    Dim i As Long, j As Long, k As Long
    For i = 0 To UBound(arr)
        For j = 0 To UBound(arr, 2)
            For k = 0 To UBound(arr, 3)
                arr(i, j, k) = VBA.Format(i, "x0") & VBA.Format(j, "\y0") & VBA.Format(j, "z0=") & VBA.Format(VBA.Rnd() * 100, "0")
            Next
        Next
    Next
    
    ToOneDim arr
    
    Debug.Print VBA.Join(arr, "|")
End Sub


Function ToOneDim(arr As Variant) As Long
    If Not VBA.IsArray(arr) Then
        ToOneDim = -1
        Exit Function
    End If
    
    Dim ptr As Long
    Dim sa As SafeArray
    
    ptr = MyArrayPtr(arr)
    
     '获取SafeArrayBound之前的数据
    CopyMemory VarPtr(sa.cDims), ptr, 16
    If sa.cDims = 1 Then Exit Function
    
    ReDim sa.rgsabound(sa.cDims - 1) As SafeArrayBound
    '根据维度再读取需要的数据
    CopyMemory VarPtr(sa.rgsabound(0).cElements), ptr + 16, sa.cDims * 8
    
    '修改为一维
    '修改rgsabound(0)的个数
    Dim i As Long
    For i = 1 To sa.cDims - 1
        sa.rgsabound(0).cElements = sa.rgsabound(0).cElements * sa.rgsabound(i).cElements
    Next
    sa.cDims = 1
    
    '反写到数组
    CopyMemory ptr, VarPtr(sa), 16
    CopyMemory ptr + 16, VarPtr(sa.rgsabound(0).cElements), 8
End Function


Function MyArrayPtr(ByRef v As Variant) As Long
    Dim b(16 - 1) As Byte
    
    CopyMemory VarPtr(b(0)), VarPtr(v), 16
'    Printf "b = 0x% x", b
    
    Dim ptr As Long
    CopyMemory VarPtr(ptr), VarPtr(b(8)), 4
'    - 0x20 8-11存的是数组地址
'    - 0x60 8-11存的是数组地址的地址
    If b(1) = &H60 Then
        CopyMemory VarPtr(ptr), ptr, 4
    End If
    
    MyArrayPtr = ptr
End Function

当然这里要注意看是不是自己需要的输出顺序，如果不是，那么应该只能通过For循环来处理了。

数据库

文章转载自VBA 学习，如果涉嫌侵权，请发送邮件至：contact@modb.pro进行举报，并提供相关证据，一经查实，墨天轮将立刻删除相关内容。

VBA多维数组转一维数组

评论