VBA使用循环转置数据

时间:2018-02-12 15:31:41

标签: vba loops transpose

有没有办法在同一张表中转换表格(固定大小,9行,9列),而不使用VBA中的转换功能? 只是使用循环?

我设法转移它的代码是(不是最好的,但有效):

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

1 个答案:

答案 0 :(得分: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

结果:

Loop transpose