office 365新增函数《TAKE 函数》和《DROP 函数》可以获取/删除单元格区域开头或结尾连续行、列,并返回一个单元格区域
对于没有office 365又想使用这个函数,就只能自己写VBA代码自定义函数了
row和col参数:正数为行从上往下、列从左往右,1为最上/最左;负数则相反,-1为最下/最右,依次类推;参数为0时,mode为"+“则获取所有行/列,mode为”-"则删除所有行/列
Function takearr(data_arr, Optional mode As String = "+", Optional row As Long = 0, Optional col As Long = 0)
'函数定义choosearr(区域,模式获取/删除,行数、列数)对数组按模式获取指定行/列,返回一个二维数组
'2种模式,"+"即TAKE获取行/列、"-"即DROP删除行/列
'可对多行多列获取/删除单行、单列、多行多列;data_arr和返回数组从1开始计数
Dim i&, j&, x&, y&, result
Dim max_r&, max_c&, start_r&, end_r&, start_c&, end_c&
'参数检查、规范
If LBound(data_arr) = 0 Or LBound(data_arr, 2) = 0 Then '转为从1开始计数
data_arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(data_arr))
End If
max_r = UBound(data_arr): max_c = UBound(data_arr, 2)
If row > 0 And row > max_r Then
row = max_r
ElseIf row < 0 And row < -max_r Then
row = -max_r
End If
If col > 0 And col > max_c Then
col = max_c
ElseIf col < 0 And col < -max_c Then
col = -max_c
End If
'TAKE获取行/列,row/col为0/最大值即获取所有行/列
If mode = "+" Then
'为0、获取所有行/列的,返回原数组
If (row = 0 And col = 0) Or (Abs(row) = max_r And Abs(col) = max_c) Then takearr = data_arr: Exit Function
If row > 0 Then '开始、结束行号
start_r = 1: end_r = row
ElseIf row < 0 Then
start_r = row + max_r + 1: end_r = max_r
ElseIf row = 0 Then
start_r = 1: end_r = max_r
End If
If col > 0 Then '开始、结束列号
start_c = 1: end_c = col
ElseIf col < 0 Then
start_c = col + max_c + 1: end_c = max_c
ElseIf col = 0 Then
start_c = 1: end_c = max_c
End If
'遍历写入数组
ReDim result(1 To end_r - start_r + 1, 1 To end_c - start_c + 1)
For i = start_r To end_r
x = x + 1: y = 0
For j = start_c To end_c
y = y + 1
result(x, y) = data_arr(i, j)
Next
Next
takearr = result
'DROP删除行/列,row/col为0/最大值即删除所有行/列
ElseIf mode = "-" Then
'为0、删除所有行/列的,返回空数组
If row = 0 Or col = 0 Or Abs(row) = max_r Or Abs(col) = max_c Then takearr = Array(): Exit Function
If row > 0 Then '开始、结束行号
start_r = row + 1: end_r = max_r
ElseIf row < 0 Then
start_r = 1: end_r = row + max_r
End If
If col > 0 Then '开始、结束列号
start_c = col + 1: end_c = max_c
ElseIf col < 0 Then
start_c = 1: end_c = col + max_c
End If
'遍历写入数组
ReDim result(1 To end_r - start_r + 1, 1 To end_c - start_c + 1)
For i = start_r To end_r
x = x + 1: y = 0
For j = start_c To end_c
y = y + 1
result(x, y) = data_arr(i, j)
Next
Next
takearr = result
End If
End Function
举例
Private Sub takearr测试()
Dim arr, result
arr = [a1].CurrentRegion.Value
'区域获取行列
' result = takearr(arr, "+", 2, 5)
' [a7].Resize(UBound(result), UBound(result, 2)) = result
' result = takearr(arr, "+", 2, 0)
' [a11].Resize(UBound(result), UBound(result, 2)) = result
' result = takearr(arr, "+", -2, -5)
' [a15].Resize(UBound(result), UBound(result, 2)) = result
'区域删除行列
result = takearr(arr, "-", 2, 5)
[a19].Resize(UBound(result), UBound(result, 2)) = result
result = takearr(arr, "-", 2, 0)
Debug.Print TypeName(result), LBound(result), UBound(result) '空数组
result = takearr(arr, "-", -2, -5)
[a23].Resize(UBound(result), UBound(result, 2)) = result
End Sub