Excel·VBA单元格区域获取/删除连续行列函数

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