VBA 使用循环转置数据

Question

有没有办法在同一个 sheet 中转置 table（固定大小，9 行，9 列），而不使用 VBA 中的内置函数 Transpose ？只使用循环？

我设法转置它的代码是（不是最好的，但有效）：

Dim RowNum As Long
Dim ColNum As Long
Dim data, result

Application.ScreenUpdating = False

If Range("a1") = "" Then Exit Sub


    With Range("a1", Cells(Rows.Count, Columns.Count).End(xlUp)).Resize(9, 9)
    data = .Value
    NumRows = UBound(data)

    For ColNum = 1 To 1

        For RowNum = 1 To 1

           Range((Cells(RowNum, ColNum)), (Cells(RowNum + 8, ColNum + 8))).Copy

           'Transpose
           Cells(RowNum + 10, ColNum).Select
           Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

        Next RowNum

    Next ColNum

    End With

    Application.ScreenUpdating = True

Answer 1

是不是很简单

Public Sub TEST()

    Dim myArr()

    Dim sourceRng As Range
    Set sourceRng = ActiveSheet.Range("A1:I9")

    myArr = sourceRng.Value

    Dim myArrTransposed()
    ReDim myArrTransposed(1 To UBound(myArr, 2), 1 To UBound(myArr, 1))

    Dim i As Long, j As Long

    For i = LBound(myArr, 1) To UBound(myArr, 1)

      For j = LBound(myArr, 2) To UBound(myArr, 2)

            myArrTransposed(j, i) = myArr(i, j)

      Next j


    Next i

    ActiveSheet.Range("A12").Resize(UBound(myArrTransposed, 1), UBound(myArrTransposed, 2)) = myArrTransposed

End Sub

结果：

VBA 使用循环转置数据

VBA Transpose data with loops

vba

transpose

loops