vba如何定义动态多维数组

redim preserve 只能改变数组的最后一维,redim preserve brr(1 to 11,1 to dtsz)

Redim帮助文件内容:
如果使用了 Preserve 关键字，就只能重定义数组最末维的大小，且根本不能改变维数的数目。例如，如果数组就是一维的，则可以重定义该维的大小，因为它是最末维，也是仅有的一维。不过，如果数组是二维或更多维时，则只有改变其最末维才能同时仍保留数组中的内容。下面的示例介绍了如何在为已有的动态数组增加其最末维大小的同时而不清除其中所含的任何数据。
因为前面有了
ReDim brr(1 to 1, 1 To 11)
所有
ReDim Preserve brr(1 To DTSZ, 1 To 11)是不允许的
ReDim Preserve brr(1 To 1, 1 To 100000)是可以的

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
不是我写的,香川群子写的,用起来挺方便,我经常用.