将列向量转置为行向量

Question

我应该面对一个简单的任务，但我发现将一维数组/列向量 [0..n， 0..0] 转置为一维数组/行向量 [0..0， 0..n] 存在一些问题。

我尝试使用Application.WorksheetFunction.Transpose内置函数，但没有成功。它似乎仅适用于 nD 数组/矩阵。

上下文是： - 1D 数组/列向量来自 Recordset.GetRows 方法(如果 Recordset.Recordcount=1 => 数组是 1D 数组/列向量( - 1D 数组/行向量(由转置函数获得(用于填充列表框对象的 listbox.list 属性

有没有一种聪明的方法可以转置一维数组(从列向量到行向量，反之亦然(？

提前感谢您的任何帮助

Answer 1

转置从零开始的数组

• Application.Transpose的问题在于它转置了 1D 从任意基于单行数组到基于 2D一的单列数组。现在，当您尝试转置回去时，最终会得到一个基于一维的单行数组(请参阅TransposeIssue(。
• 切换转置将"识别"数组是否垂直或 水平并将相应地转置(见toggleTransposeTest(。它将只接受从零开始的数组。

《守则》

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Transposes a 1D zero-based (one-row) array                      '
'                       to a 2D zero-based one-column array and vice versa.    '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function toggleTranspose0(SourceArray As Variant) As Variant
Dim Transpose, i As Long
On Error Resume Next
i = UBound(SourceArray, 2)
If Err.Number <> 0 Then
On Error GoTo 0
If LBound(SourceArray) <> 0 Then Exit Function
GoSub transposeVertical
Else
If i <> 0 Then Exit Function
GoSub transposeHorizontal
End If
toggleTranspose0 = Transpose
Exit Function
transposeVertical:
ReDim Transpose(UBound(SourceArray), 0)
For i = 0 To UBound(SourceArray)
Transpose(i, 0) = SourceArray(i)
Next i
Return
transposeHorizontal:
ReDim Transpose(UBound(SourceArray))
For i = 0 To UBound(SourceArray)
Transpose(i) = SourceArray(i, 0)
Next i
Return
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub toggleTransposeTest()
Dim v, t, i As Long
ReDim v(9)
' Populate data to 1D array.
For i = 0 To 9
v(i) = i + 1
Next i
' Transpose to 2D zero-based one-column array.
t = toggleTranspose0(v)
For i = 0 To 9
Debug.Print t(i, 0)
Next i
' Transpose back to 1D array.
v = toggleTranspose0(t)
For i = 0 To 9
Debug.Print v(i)
Next i
End Sub
Sub TransposeIssue()
Dim v, t, i As Long
ReDim v(9)
' Populate data to 1D zero-based one-row array.
For i = 0 To 9
v(i) = i + 1
Debug.Print i, v(i)
Next i
' Convert 1D array to a 1D one-based one-row array.
t = Application.Transpose(Application.Transpose(v))
For i = 1 To 10
Debug.Print i, t(i)
Next
' Transpose to 2D one-based one-column array.
t = Application.Transpose(v)
For i = 1 To 10
Debug.Print i, t(i, 1)
Next
' Transpose to 1D one-based one-row array.
v = Application.Transpose(t)
For i = 1 To 10
Debug.Print i, v(i)
Next
End Sub

Answer 2

从@VBasic2008建议的代码开始，我发布了我编写的 UDF 函数来管理所有转置场景。

特征：

• 基于任意的阵列管理
• 在 UDF 函数退出时不修改输入数组的基数
用于管理 1D(单行(阵列
• /1D(单列(阵列的 2 个选项

Function Transpose(sAr As Variant, Optional Force2DOneRowArray As Boolean = True, Optional Force2DOneClmArray As Boolean = True) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Transposes any-based array, manages in the right way the case of                  '
'               2D (one-row) array/1D array to a 2D (one-column) array and vice versa             '
' Arguments:                                                                                      '
' - sAr                Source Array                                                               '
' - Force2DOneRowArray Force function to transpose 2D matrix [n x 0]/1D (one-column) array to     '
'                      2D matrix [0 x n]/1D (one-row) array rather than to a simple 1D array      '
' - Force2DOneClmArray Force function to transpose 2D matrix [0 x n]/1D (one-row) array to        '
'                      2D matrix [n x 0]/1D (one-column) array rather than to a simple 1D array   '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim tAr As Variant
Dim i As Long, j As Long
On Error Resume Next
i = UBound(sAr, 2)
If Err.Number <> 0 Then                                 '1D (one-row) array --> Vertical transpose
On Error GoTo 0
ReDim tAr(LBound(sAr) To UBound(sAr), 0)
For i = LBound(sAr) To UBound(sAr)
tAr(i, 0) = sAr(i)
Next i
Else                                                    '2D array
If i <> 0 Then
If UBound(sAr) <> 0 Then                        '2D matrix [n x m]
ReDim tAr(LBound(sAr, 2) To UBound(sAr, 2), LBound(sAr) To UBound(sAr))
For i = LBound(sAr, 2) To UBound(sAr, 2)
For j = LBound(sAr) To UBound(sAr)
tAr(i, j) = sAr(j, i)           '2D matrix [n x m] --> 2D matrix [m x n]
Next j
Next i
Else                                            '2D matrix [0 x n]/1D (one-row) array --> Vertical transpose
If Force2DOneClmArray Then
ReDim tAr(LBound(sAr, 2) To UBound(sAr, 2), 0)
For i = LBound(sAr, 2) To UBound(sAr, 2)
tAr(i, 0) = sAr(0, i)           '2D matrix [n x 0]/1D (one-column) array
Next i
Else
ReDim tAr(LBound(sAr, 2) To UBound(sAr, 2))
For i = LBound(sAr, 2) To UBound(sAr, 2)
tAr(i) = sAr(0, i)              '1D array
Next i
End If
End If
Else                                                '2D matrix [n x 0]/1D (one-column) array --> Horizontal transpose
If Force2DOneRowArray Then
ReDim tAr(0, LBound(sAr) To UBound(sAr))
For i = LBound(sAr) To UBound(sAr)
tAr(0, i) = sAr(i, 0)               '2D matrix [0 x n]/1D (one-row) array
Next i
Else
ReDim tAr(LBound(sAr) To UBound(sAr))
For i = LBound(sAr) To UBound(sAr)
tAr(i) = sAr(i, 0)                  '1D array
Next i
End If
End If
End If
Transpose = tAr
End Function