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

office 365新增函数《WRAPROWS 函数》、《WRAPCOLS 函数》、《TOROW 函数》、《TOCOL 函数》可以将单元格区域按固定的行数、列数转换为新的单元格区域

对于没有office 365又想使用这个函数，就只能自己写VBA代码自定义函数了

Function wraparr(data_arr, Optional mode As String = "row", Optional wrap_count As Long = 1)
    '函数定义wraparr(区域，模式行/列，固定行/列数)对区域按模式、固定行/列数，转换返回一个二维数组
    '2种模式，"row"即固定行数、"col"即固定列数；若无足够的元素填充，则为空值；数组从1开始计数
    '可将单行、单列、多行多列转换为单行、单列、多行多列；固定行数时按行写入，固定列数时按列写入
    Dim data_count&, n&, i&, j&, x&, y&, arr, result
    data_count = (UBound(data_arr) - LBound(data_arr) + 1) * (UBound(data_arr, 2) - LBound(data_arr, 2) + 1)  '数组最大个数
    ReDim arr(1 To data_count)
    For i = LBound(data_arr) To UBound(data_arr)
        For j = LBound(data_arr, 2) To UBound(data_arr, 2)
            x = x + 1
            arr(x) = data_arr(i, j)
        Next
    Next
'--------------------for...each写法
'    data_arr = WorksheetFunction.Transpose(data_arr)
'    For Each a In data_arr
'        x = x + 1
'        arr(x) = a
'    Next
    '固定行数返回数组的列数，固定列数反之；向上取整
    n = WorksheetFunction.RoundUp(data_count / wrap_count, 0)
    If LCase(mode) = "row" Then
        '固定行数，按行写入
        ReDim result(1 To wrap_count, 1 To n)
        For i = 1 To wrap_count
            For j = 1 To n
                y = y + 1
                If y <= data_count Then result(i, j) = arr(y) Else Exit For
            Next
        Next
    ElseIf LCase(mode) = "col" Then
        '固定列数，按列写入
        ReDim result(1 To n, 1 To wrap_count)
        For j = 1 To wrap_count
            For i = 1 To n
                y = y + 1
                If y <= data_count Then result(i, j) = arr(y) Else Exit For
            Next
        Next
    End If
    wraparr = result
End Function

举例

Private Sub wraparr测试()
    Dim arr, result
    arr = [a1].CurrentRegion.Value
    '区域转换为多行多列
    result = wraparr(arr, "row", 6)
    [a7].Resize(UBound(result), UBound(result, 2)) = result
    '区域转换为多行多列，有多余
    result = wraparr(arr, "col", 5)
    [a15].Resize(UBound(result), UBound(result, 2)) = result
End Sub