ReDim VBA中的multidimensional array

我已经根据需要设置了运行IBM Cognos公式的注释。

为此，我将范围放入一个数组（LCogRng）。

我得到“下标超出范围”。 一旦我到达ReDim Preserve LCogRng(1 To N, 1 To 2) As Range 。

它在没有Preserve情况下工作，但是这个失败了。

 Dim wb As Workbook Dim ws As Worksheet Dim rng As Range, N As Integer Dim CogArr() As String Dim LCogRng() As Range Sub AddTM1() Set wb = ActiveWorkbook For Each ws In wb.Worksheets ReDim CogArr(1 To 1) As String ReDim LCogRng(1 To 1, 1 To 2) As Range ws.Activate For Each rng In ws.UsedRange N = Mid(rng.Comment.Text, 3, InStr(rng.Comment.Text, ":") - 3) cFormula = Mid(rng.Comment.Text, 5 + N, Len(rng.Comment.Text)) If CogArr(1) = "" Then CogArr(1) = cFormula Set LCogRng(1, 1) = rng ElseIf UBound(CogArr) < N Then ReDim Preserve CogArr(1 To N) As String ReDim Preserve LCogRng(1 To N, 1 To 2) As Range 'Error row CogArr(N) = cFormula Set LCogRng(N, 1) = rng End If ElseIf InStr(rng.Comment.Text, "TM") > 0 And Len(rng.Comment.Text) <= 6 Then N = Mid(rng.Comment.Text, 5, 2) Set LCogRng(N, 2) = rng End If End If Next rng 

任何帮助深表感谢。

Answer 1

对于二维数组，您可以使用TRANSPOSE重新排列第一个二维数组，即：

 Sub UpdateArray() Dim X 'çreate 4*2 array X = [{"Apple","2";"Bananna","3";"Don","Bradman";"#Fail","PUA"}] MsgBox UBound(X, 1) & " " & UBound(X, 2) ReDim Preserve X(1 To UBound(X, 1), 1 To UBound(X, 2) + 1) X = Application.Transpose(X) ReDim Preserve X(1 To UBound(X, 1), 1 To UBound(X, 2) + 1) X = Application.Transpose(X) 'you now have a 5*3 array MsgBox UBound(X, 1) & " " & UBound(X, 2) End Sub