将二维数组转换为一维（不使用循环）
我发现这适用于Excel范围，其中结果将是数组（n）符号而不是数组（1，n）
Result = Application.Transpose(Application.Transpose(Worksheets(kSheet).Range("Y20:AC20"))) 不过，我有一个数组（n，0）符号.getrows的结果。 这可以转换成类似于上面的arry（n）符号吗？
你发现了一个exception（bug？），并且对这个exception的解释非常有限，请问如何扩展它的可用性。 这就是为什么没有人能理解你的问题。
exception的解释
如果将单个单元格加载到types为Variant的variables中，Variant将按单元格定义的types保存单个值。
如果将一个列加载到Varianttypes的variables中，那么Variant将保存具有维数(1 To NumRows, 1 To 1)的数组，每个元素的types由相应的单元格定义。
如果将一行加载到Varianttypes的variables中，Variant将保存具有维度的数组(1 To 1, 1 To NumCols) 。
如果将一个矩形加载到Varianttypes的variables中，Variant将保存一个包含维度的数组(1 To NumRows, 1 To NumCols) 。
如果您不喜欢尺寸的顺序，您可以使用WorksheetFunction.Transpose来交换它们。
如果您使用两次WorksheetFunction.Transpose ，我希望该数组将被还原到其原始状态。 我找不到任何其他文件。
您已经发现如果您加载一个行，然后使用WorksheetFunction.Transpose两次，第一个维度被删除。 也就是说，维度从(1 To 1, 1 To NumCols)到(1 To 1, 1 To NumCols)更改为(1 To NumCols) 。
但是，如果您加载一个列，然后使用两次WorksheetFunction.Transpose ，维度将还原到其原始状态。
我的解决scheme
我认为行上的WorksheetFunction.Transpose是一个bug。 依赖于一个错误的问题是它可能会在未来版本的Excel中修复，或者在早期版本中可能不存在。
我最近发现的另一个问题是，一些或许所有的工作表函数都很慢。 我怀疑它们在工作表公式中使用时很慢，所以假设这是VBA调用的开销。
下面的macrosTimings表明了这种效果。 时间来自我的2.1 GHz笔记本电脑; 你的时间可能会不同，但我希望这种关系不变。 还要注意，我所显示的时间是来自macros的10次运行的平均值。
填写工作表“Sheet1”的“A1：T10000”的值。 macrosTimings从工作表加载数据并进行操作以获取这些定时：
Secs Action .165 Load (1 To 10000, 1 To 20) .806 Worksheet Transpose to (1 To 20, 1 To 10000) .220 Worksheet Transpose to (1 To 10000, 1 To 20) .118 TransposeVar Transpose to (1 To 20, 1 To 10000) .181 TransposeVar Transpose to (1 To 10000, 1 To 20) .031 Load (1 To 20, 1 To 1) .039 Transpose twice (1 To 20, 1 To 1) .000 Load (1 To 1, 1 To 20) .000 Transpose twice (1 To 20)
我不知道为什么换一种方式比换一种方式更快。 但是，您可以看到WorksheetFunction.Transpose需要我的VBA例程的三倍。 如果你只加载一个范围，这是不重要的。 但是，如果您正在加载多个范围，则额外的时间将变得重要。
第二组行显示加载一个列并转置两次的效果，以及加载一行并转置两次的效果。 最后一行显示了您发现的exception情况：第一个维度已被双重转置删除。
macrosTest演示使用函数RemoveUpperEqLowerDim 。 你问如何扩大exception的使用; 我不相信这是可能的。 函数RemoveUpperEqLowerDim可以使用循环，但WorksheetFunction.Transpose更快，并且可以同时处理行和列的范围。
Option Explicit Sub Timings() Dim CellValue1 As Variant Dim CellValue2 As Variant Dim CellValue3 As Variant Dim ColCrnt As Long Dim RowCrnt As Long Dim TimeStart As Single Debug.Print "Secs Action" ' Load rectangle TimeStart = Timer CellValue1 = Worksheets("Sheet1").Range("A1:T10000") Debug.Print Format(Timer - TimeStart, ".000") & " Load " & ArrayBounds(CellValue1) ' Load rectangle TimeStart = Timer CellValue2 = Worksheets("Sheet1").Range("A1:T10000") Debug.Print Format(Timer - TimeStart, ".000") & " Load " & ArrayBounds(CellValue2) ' Transpose rectangle using WorksheetFunction.Transpose TimeStart = Timer CellValue2 = WorksheetFunction.Transpose(CellValue2) Debug.Print Format(Timer - TimeStart, ".000") & " Worksheet Transpose to " & _ ArrayBounds(CellValue2) ' Transpose rectangle using WorksheetFunction.Transpose back to original state TimeStart = Timer CellValue2 = WorksheetFunction.Transpose(CellValue2) Debug.Print Format(Timer - TimeStart, ".000") & " Worksheet Transpose to " & _ ArrayBounds(CellValue2) ' Check twice transposed array matches copy of original For RowCrnt = LBound(CellValue2, 1) To UBound(CellValue2, 1) For ColCrnt = LBound(CellValue2, 2) To UBound(CellValue2, 2) If CellValue1(RowCrnt, ColCrnt) <> CellValue1(RowCrnt, ColCrnt) Then Debug.Assert False End If Next Next ' Transpose rectangle using VBA function TransposeVar TimeStart = Timer Call TransposeVar(CellValue3, CellValue2) Debug.Print Format(Timer - TimeStart, ".000") & " TransposeVar Transpose to " & _ ArrayBounds(CellValue3) ' Transpose rectangle using VBA function TransposeVar back to original state TimeStart = Timer Call TransposeVar(CellValue2, CellValue3) Debug.Print Format(Timer - TimeStart, ".000") & " TransposeVar Transpose to " & _ ArrayBounds(CellValue2) ' Check twice transposed array matches copy of original For RowCrnt = LBound(CellValue2, 1) To UBound(CellValue2, 1) For ColCrnt = LBound(CellValue2, 2) To UBound(CellValue2, 2) If CellValue1(RowCrnt, ColCrnt) <> CellValue1(RowCrnt, ColCrnt) Then Debug.Assert False End If Next Next ' Load column TimeStart = Timer CellValue1 = Worksheets("Sheet1").Range("A1:A20") Debug.Print Format(Timer - TimeStart, ".000") & " Load " & ArrayBounds(CellValue1) ' Transpose column twice with WorksheetFunction.Transpose TimeStart = Timer CellValue2 = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Worksheets("Sheet1").Range("A1:A20"))) Debug.Print Format(Timer - TimeStart, ".000") & " Transpose twice " & ArrayBounds(CellValue2) ' Load row TimeStart = Timer CellValue1 = Worksheets("Sheet1").Range("A20:T20") Debug.Print Format(Timer - TimeStart, ".000") & " Load " & ArrayBounds(CellValue1) ' Transpose row twice with WorksheetFunction.Transpose. Column dimension is removed. TimeStart = Timer CellValue2 = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Worksheets("Sheet1").Range("A20:T20"))) Debug.Print Format(Timer - TimeStart, ".000") & " Transpose twice " & ArrayBounds(CellValue2) End Sub Sub Test() Dim CellValue1 As Variant Dim CellValue2 As Variant Dim InxCrnt As Long ' Load column CellValue1 = Worksheets("Sheet1").Range("A1:A20") Debug.Print " CellValue1 " & ArrayBounds(CellValue1) ' Remove row dimension CellValue2 = RemoveUpperEqLowerDim(CellValue1) Debug.Print " CellValue2 " & ArrayBounds(CellValue2) ' Check values match For InxCrnt = LBound(CellValue1, 1) To UBound(CellValue1, 1) If CellValue1(InxCrnt, 1) <> CellValue2(InxCrnt) Then Debug.Assert False End If Next ' Load row CellValue1 = Worksheets("Sheet1").Range("A20:T20") Debug.Print " CellValue1 " & ArrayBounds(CellValue1) ' Remove column dimension CellValue2 = RemoveUpperEqLowerDim(CellValue1) Debug.Print " CellValue2 " & ArrayBounds(CellValue2) ' Check values match For InxCrnt = LBound(CellValue1, 2) To UBound(CellValue1, 2) If CellValue1(1, InxCrnt) <> CellValue2(InxCrnt) Then Debug.Assert False End If Next Dim Inx1Crnt As Long Dim Inx2Crnt As Long ' Load rectangle CellValue1 = Worksheets("Sheet1").Range("A1:T30") Debug.Print " CellValue1 " & ArrayBounds(CellValue1) ' CellValue2 becomes copy of CellValue1 CellValue2 = RemoveUpperEqLowerDim(CellValue1) Debug.Print " CellValue2 " & ArrayBounds(CellValue2) ' Check values match For Inx1Crnt = LBound(CellValue1, 1) To UBound(CellValue1, 1) For Inx2Crnt = LBound(CellValue1, 2) To UBound(CellValue1, 2) If CellValue1(Inx1Crnt, Inx2Crnt) <> CellValue2(Inx1Crnt, Inx2Crnt) Then Debug.Assert False End If Next Next End Sub Function ArrayBounds(ParamArray Tgt() As Variant) As String Dim InxDimCrnt As Long Dim InxDimMax As Long InxDimMax = NumDim(Tgt(0)) ArrayBounds = "(" For InxDimCrnt = 1 To InxDimMax If InxDimCrnt > 1 Then ArrayBounds = ArrayBounds & ", " End If ArrayBounds = ArrayBounds & LBound(Tgt(0), InxDimCrnt) & " To " & UBound(Tgt(0), InxDimCrnt) Next ArrayBounds = ArrayBounds & ")" End Function Public Function NumDim(ParamArray TestArray() As Variant) As Integer ' Returns the number of dimensions of TestArray. ' If there is an official way of determining the number of dimensions, I cannot find it. ' This routine tests for dimension 1, 2, 3 and so on until it get a failure. ' By trapping that failure it can determine the last test that did not fail. ' Coded June 2010. Documentation added July 2010. ' * TestArray() is a ParamArray because it allows the passing of arrays of any type. ' * The array to be tested in not TestArray but TestArray(LBound(TestArray)). ' * The routine does not validate that TestArray(LBound(TestArray)) is an array. If ' it is not an array, the routine return 0. ' * The routine does not check for more than one parameter. If the call was ' NumDim(MyArray1, MyArray2), it would ignore MyArray2. Dim TestDim As Integer Dim TestResult As Integer On Error GoTo Finish TestDim = 1 Do While True TestResult = LBound(TestArray(LBound(TestArray)), TestDim) TestDim = TestDim + 1 Loop Finish: NumDim = TestDim - 1 End Function Function RemoveUpperEqLowerDim(Var As Variant) As Variant ' * Var must be a variant redimensioned to hold a 2D array ' * If the dimensions are (M To N, P To P) or (P to P, M to N), a variant ' will be returned with the dimension with equal lower and upper bounds ' removed. That is the returned array has dimensions (M to N). ' * If neither dimension has equal lower and upper bounds, the original ' array will be returned. Dim NewVar As Variant Dim InxCrnt As Long If NumDim(Var) <> 2 Then ' There is no code to handle this situation Debug.Assert False RemoveUpperEqLowerDim = Var Exit Function End If If LBound(Var, 1) = UBound(Var, 1) Then ' The first dimension has equal bounds ReDim NewVar(LBound(Var, 2) To UBound(Var, 2)) For InxCrnt = LBound(Var, 2) To UBound(Var, 2) NewVar(InxCrnt) = Var(LBound(Var, 2), InxCrnt) Next RemoveUpperEqLowerDim = NewVar ElseIf LBound(Var, 2) = UBound(Var, 2) Then ' The second dimension has equal bounds ReDim NewVar(LBound(Var, 1) To UBound(Var, 1)) For InxCrnt = LBound(Var, 1) To UBound(Var, 1) NewVar(InxCrnt) = Var(InxCrnt, LBound(Var, 1)) Next RemoveUpperEqLowerDim = NewVar Else ' Neither dimension has equal bounds RemoveUpperEqLowerDim = Var End If End Function Sub TransposeVar(ParamArray Tgt() As Variant) ' * Example call: Call Transpose(Destination, Source) ' * Source must be a 2D array or a variant holding a 2D array. ' * Destination must be a variant. ' * On exit, Destination will contain the values from Source but with the ' dimensions reversed. ' * Tgt(0) Destination ' * Tgt(1) Source Dim ColCrnt As Long Dim RowCrnt As Long Dim Test() As String ' This call necessary because the following gives a syntax error: ' ReDim Tgt(0)(LBound(Tgt(1), 2) To UBound(Tgt(1), 2), _ ' LBound(Tgt(1), 1) To UBound(Tgt(1), 1)) Call ReDimVar(Tgt(0), Tgt(1)) For RowCrnt = LBound(Tgt(1), 1) To UBound(Tgt(1), 1) For ColCrnt = LBound(Tgt(1), 2) To UBound(Tgt(1), 2) Tgt(0)(ColCrnt, RowCrnt) = Tgt(1)(RowCrnt, ColCrnt) Next Next End Sub Sub ReDimVar(Destination As Variant, ParamArray Source() As Variant) ' * Source(0) must be a 2D array or a variant holding a 2D array ' * Redim Destination to match Source(0) but with the dimensions reversed ReDim Destination(LBound(Source(0), 2) To UBound(Source(0), 2), _ LBound(Source(0), 1) To UBound(Source(0), 1)) End Sub