代码之家 › 专栏 › 技术社区 › USER7423

VBA使用循环转置数据

transpose loops vba

USER7423 · 技术社区 · 7 年前

有没有办法在同一张表中转换一个表(固定大小,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 回复 | 直到 7 年前

QHarr 7 年前

不是很简单吗

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

结果:

推荐文章

Keren · 如何使变量大1

1 年前

smg_08 · 使用for循环在pandas数据帧中进行筛选[重复]

1 年前

stats_noob · R: 记录某个“行为”发生的循环的索引?

2 年前

nickolakis · 基于R中的列名复制列

2 年前

khalid Morrshid · 循环语法C语言

2 年前

Onur · R中矩阵的循环

2 年前

Alex · 如何向嵌套字典json添加值?

2 年前

George carrick · 如何在R中检测时间序列数据中的缺失年份?

2 年前

CS Geek · 如何实现一个循环,其中:数字不能在输入的中间使用;他们最后一定要来?

2 年前

Klang · 我怎么做我自己的绳子。Split()和数组。Reverse()一个用户定义函数中的内置函数,用于反转给定字符串?

2 年前