我发现这适用于Excel范围，其结果是 array（n）表示法而不是数组（1，n）
Result = Application.Transpose(Application.Transpose(Worksheets(kSheet).Range("Y20:AC20")))
但是我有.getrows的结果，它是数组（n，0）表示法。这可以转换为与上面类似的arry（n）符号吗？
答案 0 :(得分：2)
您发现了一个异常（错误？），并且对该异常的解释非常有限，请询问如何扩展其可用性。这就是为什么没有人能理解你的问题。
异常的解释
如果将单个单元格加载到Variant类型的变量中，则Variant将保存单个值，其值由单元格定义。
如果将列加载到Variant类型的变量中，Variant将保存一个维度为(1 To NumRows, 1 To 1)的数组，其中每个元素的类型都由相应的单元格定义。
如果将一行加载到Variant类型的变量中，Variant将保存一个维度为(1 To 1, 1 To NumCols)的数组。
如果将矩形加载到Variant类型的变量中，Variant将保存一个维度为(1 To NumRows, 1 To NumCols)的数组。
如果您不喜欢尺寸序列，可以使用WorksheetFunction.Transpose进行交换。
如果你使用WorksheetFunction.Transpose两次，我希望数组将恢复到原始状态。我找不到任何其他建议的文件。
您发现如果加载一行然后两次使用WorksheetFunction.Transpose，则会删除第一个维度。也就是说，维度从(1 To 1, 1 To NumCols)更改为(1 To NumCols)。
但是，如果您加载一列，然后两次使用WorksheetFunction.Transpose，则维度会恢复到原始状态。
我的解决方案
我认为WorksheetFunction.Transpose对某行的影响是一个错误。依赖于错误的问题在于它可能在未来版本的Excel中修复，或者可能在早期版本中不存在。
我最近发现的另一个问题是某些（可能是所有）工作表函数很慢。我怀疑它们在工作表公式中使用时很慢，所以假设这是来自VBA的调用的开销。
下面的宏Timings演示了这种效果。时间来自我的2.1 GHz笔记本电脑;你的时间可能会有所不同，但我希望这些关系不会改变。另请注意，我显示的时间是10次运行宏的平均值。
我用工作表“Sheet1”填充了“A1：T10000”的值。宏Timings从工作表加载数据并进行操作以获得这些时间：
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例程的三倍。如果您只加载一个范围，这是不重要的。但是，如果要加载许多范围，则额外的时间将变得很重要。
第二组行显示加载列并将其转置两次的效果以及加载行并将其转置两次的效果。最后一行显示您发现的异常：第一个维度已被双转置删除。
宏Test演示了函数RemoveUpperEqLowerDim的使用。你问如何扩展异常的使用;我不相信这是可能的。函数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