Excel·VBA数组行列转换函数

1，二维数组与一维嵌套数组互相转换函数

《Excel·VBA数组组合函数、组合求和》
为测试2种数据结构遍历与求和速度之间的差异所写的转换函数

Function TransposeArr(data_arr, Optional res As Long = 1)
    '二维数组与一维嵌套数组互相转换函数，data_arr和返回数组从1开始计数
    Dim i&, j&, result
    If res = 1 Then  '转为一维嵌套数组
        ReDim result(1 To UBound(data_arr) - LBound(data_arr) + 1)
        For i = LBound(data_arr) To UBound(data_arr)
            temp = Application.index(data_arr, i)
            j = j + 1: result(j) = temp
        Next
        TransposeArr = result
    ElseIf res = 2 Then  '转为二维数组
        Dim rr&, cc&, r&, c&, tmp&
        rr = UBound(data_arr) - LBound(data_arr) + 1
        For Each a In data_arr
            tmp = UBound(a) - LBound(a) + 1
            If tmp > cc Then cc = tmp
        Next
        ReDim result(1 To rr, 1 To cc)
        For Each a In data_arr
            r = r + 1: c = 0
            For i = LBound(a) To UBound(a)
                c = c + 1: result(r, c) = a(i)
            Next
        Next
        TransposeArr = result
    End If
End Function

2，二维数组转换为指定行数/列数的函数

《Excel·VBA单元格区域行列数转换函数》

3，数组行列转置函数

工作表函数WorksheetFunction.Transpose返回转置单元格区域，即将一行单元格区域转置成一列单元格区域，反之亦然。
但据说能处理的数组元素字符长度最大为255，实测在Office2019和WPS2016并未发现该限制，2048个字符也可转置

Function TransposeArray(ByVal arr)
    '数组行列转置函数，同Transpose，但无最大65536行字符长度256的限制（实测没有256限制）
    '适用一维、二维数组，单元格单行、单列、多行多列，返回数组从1开始计数
    Dim i&, j&, result, n&, x&, y&
    If IsArray(arr) Then
        n = Array_Dim(arr)  '数组维数
        If n > 2 Then Debug.Print "仅适用一维、二维数组": Exit Function
        If n = 1 Then       '一维数组
            ReDim result(1 To UBound(arr) - LBound(arr) + 1, 1 To 1)
            For i = LBound(arr) To UBound(arr)
                x = x + 1: result(x, 1) = arr(i)
            Next
        ElseIf n = 2 Then   '二维数组，单行、单列、多行多列
            ReDim result(1 To UBound(arr, 2) - LBound(arr, 2) + 1, 1 To UBound(arr) - LBound(arr) + 1)
            For i = LBound(arr) To UBound(arr)
                x = x + 1: y = 0
                For j = LBound(arr, 2) To UBound(arr, 2)
                    y = y + 1: result(y, x) = arr(i, j)
                Next
            Next
        End If
    End If
    TransposeArray = result
End Function

Function Array_Dim(ByVal arr)
    '获取数组维数，利用报错判断
    Dim i&, j&
    On Error Resume Next
    If Not IsArray(arr) Then Array_Dim = -1: Exit Function
    Do
        i = i + 1: j = UBound(arr, i)
    Loop Until Err.Number <> 0
    Array_Dim = i - 1
End Function

Sub 转置测试()
    Dim arr(1 To 2, 1 To 2)
    arr(1, 2) = Application.Rept("$", 2048)
    a = WorksheetFunction.Transpose(arr)
    b = TransposeArray(arr)
    [a1].Resize(UBound(a), UBound(a, 2)) = a
    [a4].Resize(UBound(b), UBound(b, 2)) = b
End Sub

实测都可在工作表写入2048个字符