您发现了一个异常（错误？），并且对该异常的解释非常有限，询问如何扩展其可用性。这就是为什么没有人能理解你的问题。
异常说明
如果您将单个单元格加载到 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