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" Then
x = 0
For Each n In num_arr
If IsArray(n) Then 'num_arr的参数如果是数组,该数组从0开始计数,最多3个数
If n(0) > 0 Then start_n = n(0) Else start_n = n(0) + max_r + 1
If n(1) > 0 Then end_n = n(1) Else end_n = n(1) + max_r + 1
If UBound(n) >= 2 Then step_n = n(2) Else step_n = 1
For i = start_n To end_n Step step_n
arr = Application.index(data_arr, i) '一维数组
x = x + 1: y = 0
For Each a In arr
y = y + 1
brr(x, y) = a
Next
Next
Else 'num_arr非数组的参数
arr = Application.index(data_arr, n)
x = x + 1: y = 0
For Each a In arr
y = y + 1
brr(x, y) = a
Next
End If
Next
'返回数组
If x = UBound(brr) Then
choosearr = brr
Else
ReDim result(1 To x, 1 To UBound(brr, 2)) '返回数组,避免无效部分
For i = 1 To x
For j = 1 To UBound(brr, 2)
result(i, j) = brr(i, j)
Next
Next
choosearr = result
End If
ElseIf LCase(mode) = "col" Then
y = 0
For Each n In num_arr
If IsArray(n) Then
If n(0) > 0 Then start_n = n(0) Else start_n = n(0) + max_c + 1
If n(1) > 0 Then end_n = n(1) Else end_n = n(1) + max_c + 1
If UBound(n) >= 2 Then step_n = n(2) Else step_n = 1
For i = start_n To end_n Step step_n
arr = Application.index(data_arr, , i) '二维数组
x = 0: y = y + 1
For Each a In arr
x = x + 1
brr(x, y) = a
Next
Next
Else
arr = Application.index(data_arr, , n)
x = 0: y = y + 1
For Each a In arr
x = x + 1
brr(x, y) = a
Next
End If
Next
'返回数组
If y = UBound(brr, 2) Then
choosearr = brr
Else
ReDim result(1 To UBound(brr), 1 To y)
For i = 1 To UBound(brr)
For j = 1 To y
result(i, j) = brr(i, j)
Next
Next
choosearr = result
End If
End If
End Function
举例
Private Sub choosearr测试()
Dim arr, brr, result
arr = [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)) = result
End Sub