将列向量转置为行向量

Question

我应该面对一个简单的任务，但我发现一些问题将一维 array/Column 向量 [0..n, 0..0] 转置为一维 array/Row 向量 [ 0..0, 0..n].

我尝试使用 Application.WorksheetFunction.Transpose 内置函数但没有成功。它似乎只适用于 nD array/matrix.

上下文是： - 一维 array/Column 向量来自 Recordset.GetRows 方法（如果 Recordset.Recordcount=1 => 数组是一维 array/Column 向量） - 一维 array/Row 向量（通过转置函数获得）用于填充列表框对象 listbox.list 属性

是否有转置一维数组的巧妙方法（从列向量到行向量，反之亦然）？

提前感谢您的帮助

Answer 1

转置从零开始的数组

Application.Transpose 的问题在于它转置了 1D any-based 单行数组到 2D one-based 单列数组。现在，当您尝试向后转置时，您将得到一个基于 one 的一维单行数组（参见 TransposeIssue）。
切换转置 将 'recognize' 如果阵列是垂直的或水平并将相应地转置（参见 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建议的代码开始，我post我写的UDF函数来管理所有转置场景。

特点：

基于任何数组的管理
在 UDF 函数的出口处不修改输入数组的基数
2 个用于管理一维（单行）array/1D（单列）数组的选项

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

将列向量转置为行向量

Transpose Column vector to row vector

arrays

vba

transpose

转置从零开始的数组