查看: 24  |  回复: 0
  VBA代码 香川 Index2 Index数组提取、数组Redim、数组Transpose转置 三大功能的 自定义函数
楼主
发表于 2025年3月18日 15:24
Function Index2(trr_Array_Area, Optional r_RowIndex = 0, Optional c_ColumnIndex = 0, Optional k_LBound_Transpose = 0, Optional h_RowHeight& = -1, Optional w_ColumnWidth& = -1)
    Rem 兼具 Index数组提取、数组Redim、数组Transpose转置 三大功能的 自定义函数
    Rem Index除可提取整行、整列外 更可提取任意行列位置起始的多行多列矩形局域 并可任意设置数组下标开始值(或保留原始值)
    Rem Redim则很简单 Index提取时按需要重新设置行高、列宽即可 优点是可以同时设置二维数组的2个维度 而标准Redim只能修改第2维的大小
    Rem Transpose同样简单 但由于兼具上述特点而更强大 1.任意行列位置开始 2.任意二维大小Redim 3.无65536限制
    Rem 第1参数trr_Array_Area: 为引用的VBA内存一维或二维数组如arr 或[工作表区域].Value的二维结构数组
    Rem 第2、3参数r_RowIndex 和 第3参数c_ColumnIndex:可省略。默认值=0即整行、整列,否则为数组起点开始的行、列相对位置
    Rem 第4参数k_LBound_Transpose:
    Rem     该参数可省略。 默认值=0即设置新数组起点开始LBound=0 否则如果是数值则按指定数值开始 数值应该是含0整数
    Rem     该参数为空值=""时 按原数组指定行列开始的位置作为新数组起点开始的LBound值
    Rem     该参数首字母="T"时 除Index、Redim功能外 还对数组结果进行Transpose的行列转置 但转置结果仍是二维数组
    Rem     该参数首字母="T"时 其后的数值仍可作为新数组起点开始的LBound值 因此="T"时相当于="T0"则新数组起点开始LBound=0
    Rem 第5、6参数h_RowHeight 和 w_ColumnWidth:该参数可省略。 默认值=-1即输出一维数组 否则按指定值进行多行、多列的二维数组输出
    Dim r1_RowStart&, c1_ColumnStart&, r2_RowEnd&, c2_ColumnEnd&, kr_RowLBound&, kc_ColumnLBound&, i_RowCount&, j_ColumnCount&, d_OneDimensionArray&
    On Error GoTo 1

    c1_ColumnStart = LBound(trr_Array_Area, 2)
    If r_RowIndex = 0 Then r1_RowStart = LBound(trr_Array_Area) Else r1_RowStart = LBound(trr_Array_Area) + r_RowIndex - 1
    If c_ColumnIndex = 0 Then c1_ColumnStart = LBound(trr_Array_Area, 2) Else c1_ColumnStart = LBound(trr_Array_Area, 2) + c_ColumnIndex - 1
    GoTo 2
1
    d_OneDimensionArray = 1
    If r_RowIndex = 0 Then c1_ColumnStart = 0 Else If c_ColumnIndex = 0 Then c_ColumnIndex = r_RowIndex: r_RowIndex = 0
    If c_ColumnIndex = 0 Then r1_RowStart = LBound(trr_Array_Area) Else r1_RowStart = LBound(trr_Array_Area) + c_ColumnIndex - 1
2
    If r_RowIndex > 0 And h_RowHeight = -1 Then
        If k_LBound_Transpose = "" Then kc_ColumnLBound = c1_ColumnStart Else kc_ColumnLBound = k_LBound_Transpose
        If d_OneDimensionArray = 0 Then c2_ColumnEnd = UBound(trr_Array_Area, 2)
        If w_ColumnWidth > 0 Then If c1_ColumnStart + w_ColumnWidth - 1 < c2_ColumnEnd Then c2_ColumnEnd = c1_ColumnStart + w_ColumnWidth - 1
        ReDim tr_Output(kc_ColumnLBound To c2_ColumnEnd - c1_ColumnStart + kc_ColumnLBound)
        For j_ColumnCount = c1_ColumnStart To c2_ColumnEnd
            tr_Output(j_ColumnCount - c1_ColumnStart + kc_ColumnLBound) = trr_Array_Area(r1_RowStart, j_ColumnCount)
        Next
        Index2 = tr_Output
    ElseIf c_ColumnIndex > 0 And w_ColumnWidth = -1 Then
        If k_LBound_Transpose = "" Then kr_RowLBound = r1_RowStart Else kr_RowLBound = k_LBound_Transpose
        r2_RowEnd = UBound(trr_Array_Area)
        If h_RowHeight > 0 Then If r1_RowStart + h_RowHeight - 1 < r2_RowEnd Then r2_RowEnd = r1_RowStart + h_RowHeight - 1
        ReDim tr_Output(kr_RowLBound To r2_RowEnd - r1_RowStart + kr_RowLBound)
        If d_OneDimensionArray = 1 Then
            For i_RowCount = r1_RowStart To r2_RowEnd
                tr_Output(i_RowCount - r1_RowStart + kr_RowLBound) = trr_Array_Area(i_RowCount)
            Next
        Else
            For i_RowCount = r1_RowStart To r2_RowEnd
                tr_Output(i_RowCount - r1_RowStart + kr_RowLBound) = trr_Array_Area(i_RowCount, c1_ColumnStart)
            Next
        End If
        Index2 = tr_Output
    Else
        If k_LBound_Transpose = "" Then
            kr_RowLBound = r1_RowStart: kc_ColumnLBound = c1_ColumnStart
        ElseIf k_LBound_Transpose Like "T*" Then
            If k_LBound_Transpose = "T" Then
                kr_RowLBound = r1_RowStart: kc_ColumnLBound = c1_ColumnStart
            Else
                kr_RowLBound = Val(Mid(k_LBound_Transpose, 2)): kc_ColumnLBound = kr_RowLBound
            End If
        Else
            kr_RowLBound = k_LBound_Transpose: kc_ColumnLBound = k_LBound_Transpose
        End If

        If h_RowHeight > 0 Then r2_RowEnd = r1_RowStart + h_RowHeight - 1 Else r2_RowEnd = UBound(trr_Array_Area)
        If d_OneDimensionArray = 0 Then If w_ColumnWidth > 0 Then c2_ColumnEnd = c1_ColumnStart + w_ColumnWidth - 1 Else c2_ColumnEnd = UBound(trr_Array_Area, 2)

        If k_LBound_Transpose Like "T*" Then
            ReDim tr2_Output(kc_ColumnLBound To c2_ColumnEnd - c1_ColumnStart + kc_ColumnLBound, kr_RowLBound To r2_RowEnd - r1_RowStart + kr_RowLBound)
            If r2_RowEnd > UBound(trr_Array_Area) Then r2_RowEnd = UBound(trr_Array_Area)
            If d_OneDimensionArray = 0 Then If c2_ColumnEnd > UBound(trr_Array_Area, 2) Then c2_ColumnEnd = UBound(trr_Array_Area, 2)
            If d_OneDimensionArray = 1 Then
                For i_RowCount = r1_RowStart To r2_RowEnd
                    tr2_Output(j_ColumnCount - c1_ColumnStart + kc_ColumnLBound, i_RowCount - r1_RowStart + kr_RowLBound) = trr_Array_Area(i_RowCount)
                Next
            Else
                For i_RowCount = r1_RowStart To r2_RowEnd
                    For j_ColumnCount = c1_ColumnStart To c2_ColumnEnd
                        tr2_Output(j_ColumnCount - c1_ColumnStart + kc_ColumnLBound, i_RowCount - r1_RowStart + kr_RowLBound) = trr_Array_Area(i_RowCount, j_ColumnCount)
                    Next
                Next
            End If
        Else
            ReDim tr2_Output(kr_RowLBound To r2_RowEnd - r1_RowStart + kr_RowLBound, kc_ColumnLBound To c2_ColumnEnd - c1_ColumnStart + kc_ColumnLBound)
            If r2_RowEnd > UBound(trr_Array_Area) Then r2_RowEnd = UBound(trr_Array_Area)
            If d_OneDimensionArray = 0 Then If c2_ColumnEnd > UBound(trr_Array_Area, 2) Then c2_ColumnEnd = UBound(trr_Array_Area, 2)
            If d_OneDimensionArray = 1 Then
                For i_RowCount = r1_RowStart To r2_RowEnd
                    tr2_Output(i_RowCount - r1_RowStart + kr_RowLBound, j_ColumnCount - c1_ColumnStart + kc_ColumnLBound) = trr_Array_Area(i_RowCount)
                Next
            Else
                For i_RowCount = r1_RowStart To r2_RowEnd
                    For j_ColumnCount = c1_ColumnStart To c2_ColumnEnd
                        tr2_Output(i_RowCount - r1_RowStart + kr_RowLBound, j_ColumnCount - c1_ColumnStart + kc_ColumnLBound) = trr_Array_Area(i_RowCount, j_ColumnCount)
                    Next
                Next
            End If
        End If

        Index2 = tr2_Output
    End If
End Function


您需要登录后才可以回帖 登录 | 立即注册
【本版规则】请勿发表违反国家法律的内容,否则会被冻结账号和删贴。
用户名: 立即注册
密码:
2020-2025 MaNongKu.com