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, resultdata_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 + 1arr(x) = data_arr(i, j)NextNext'--------------------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_countFor j = 1 To ny = y + 1If y <= data_count Then result(i, j) = arr(y) Else Exit ForNextNextElseIf LCase(mode) = "col" Then'固定列数，按列写入ReDim result(1 To n, 1 To wrap_count)For j = 1 To wrap_countFor i = 1 To ny = y + 1If y <= data_count Then result(i, j) = arr(y) Else Exit ForNextNextEnd Ifwraparr = resultEnd Function

举例

Private Sub wraparr测试()Dim arr, resultarr = [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)) = resultEnd Sub