office 365新增函数《CHOOSEROWS 函数》和《CHOOSECOLS 函数》可以获取单元格区域指定行、列,并返回一个单元格区域
对于没有office 365又想使用这个函数,就只能自己写VBA代码自定义函数了
num_arr参数:正数为行从上往下、列从左往右,1为最上/最左;负数则相反,-1为最下/最右,依次类推
Function choosearr(data_arr, Optional mode As String = "row", Optional num_arr = Null)'函数定义choosearr(区域,模式行/列,获取的行/列数数组)对数组按模式获取指定行/列,返回一个二维数组'2种模式,"row"即按行获取、"col"即按列获取;返回数组定义最大为原数组(重复获取的需自行修改代码)'可对单行、单列、多行多列获取单行、单列、多行多列;data_arr和返回数组从1开始计数'num_arr的参数如果为数组,即为遍历获取,数组(初值,终值,步长);如果为常数,即为指定行/列数Dim n, a, i&, j&, x&, y&, arr, brr, result'临时数组,定义为原数组大小max_r = UBound(data_arr): max_c = UBound(data_arr, 2)ReDim brr(1 To max_r, 1 To max_c)If LCase(mode) = "row" Thenx = 0For Each n In num_arrIf IsArray(n) Then 'num_arr的参数如果是数组,该数组从0开始计数,最多3个数If n(0) > 0 Then start_n = n(0) Else start_n = n(0) + max_r + 1If n(1) > 0 Then end_n = n(1) Else end_n = n(1) + max_r + 1If UBound(n) >= 2 Then step_n = n(2) Else step_n = 1For i = start_n To end_n Step step_narr = Application.index(data_arr, i) '一维数组x = x + 1: y = 0For Each a In arry = y + 1brr(x, y) = aNextNextElse 'num_arr非数组的参数arr = Application.index(data_arr, n)x = x + 1: y = 0For Each a In arry = y + 1brr(x, y) = aNextEnd IfNext'返回数组If x = UBound(brr) Thenchoosearr = brrElseReDim result(1 To x, 1 To UBound(brr, 2)) '返回数组,避免无效部分For i = 1 To xFor j = 1 To UBound(brr, 2)result(i, j) = brr(i, j)NextNextchoosearr = resultEnd IfElseIf LCase(mode) = "col" Theny = 0For Each n In num_arrIf IsArray(n) ThenIf n(0) > 0 Then start_n = n(0) Else start_n = n(0) + max_c + 1If n(1) > 0 Then end_n = n(1) Else end_n = n(1) + max_c + 1If UBound(n) >= 2 Then step_n = n(2) Else step_n = 1For i = start_n To end_n Step step_narr = Application.index(data_arr, , i) '二维数组x = 0: y = y + 1For Each a In arrx = x + 1brr(x, y) = aNextNextElsearr = Application.index(data_arr, , n)x = 0: y = y + 1For Each a In arrx = x + 1brr(x, y) = aNextEnd IfNext'返回数组If y = UBound(brr, 2) Thenchoosearr = brrElseReDim result(1 To UBound(brr), 1 To y)For i = 1 To UBound(brr)For j = 1 To yresult(i, j) = brr(i, j)NextNextchoosearr = resultEnd IfEnd IfEnd Function
举例
Private Sub choosearr测试()Dim arr, brr, resultarr = [a1].CurrentRegion.Value'区域获取常数行' brr = Array(1, 3)' result = choosearr(arr, , brr)' [a7].Resize(UBound(result), UBound(result, 2)) = result'区域遍历获取列' brr = Array(Array(1, 9, 2))' result = choosearr(arr, "col", brr)' [a11].Resize(UBound(result), UBound(result, 2)) = result'区域遍历获取列2' brr = Array(Array(1, 9, 2), 2, Array(4, 9, 2))' result = choosearr(arr, "col", brr)' [a17].Resize(UBound(result), UBound(result, 2)) = result'区域倒序遍历获取列' brr = Array(Array(-1, 1, -2))' result = choosearr(arr, "col", brr)' [a23].Resize(UBound(result), UBound(result, 2)) = result'区域倒序遍历获取行brr = Array(Array(-2, 1, -2))result = choosearr(arr, "row", brr)[a29].Resize(UBound(result), UBound(result, 2)) = resultEnd Sub
如果觉得《Excel·VBA单元格区域获取指定行列函数》对你有帮助,请点赞、收藏,并留下你的观点哦!