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