Question

我目前正在处理从Morningstar Direct下载的大量数据。我需要一个宏的帮助，可以将导出的文档从水平更改为垂直。我已经尝试了excel中的所有函数而没有任何运气，所以我认为我需要一个宏来进行此操作。

例如：

自：

Data1-2000    Data1-2001   Data1-2002 ... Data1-2016   Data2-2000   Data2-2001 and so on

致：

Data1-2000  
Data1-2001  
   ...  
Data1-2016  
Data2-2000  
Data2-2001  
     ...

每个数据变量从2000年到2016年。我们有超过500个代码需要相同的转换。有没有可以为我做这个的VBA代码？它会拯救我的生命（至少是我的复活节）！

来自OP的回答帖子中的附加信息：

我制作了这个宏：

Sub Flip()
'
' Flip Macro
'
    Sheets("S&P 500 Constituents").Select
    Range("I2:X2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("S&P 500 Constituents").Select
    Range("AB2:AQ2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("S&P 500 Constituents").Select
    Range("AR2:BG2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("S&P 500 Constituents").Select
    Range("BH2:BW2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("S&P 500 Constituents").Select
    Range("BX2:CM2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

End Sub

正如您所看到的，我的S＆amp; P500表中的所有内容都来自第2行，然后转换为sheet1。

如何让这个宏在第3,4,5 ... 518行重复相同的操作？

Answer 1

尝试INDEX function。

=INDEX($1:$1, 1, ROW(1:1))

附录：VBA strip & transpose

将S＆amp; P 500成分工作表中的值转换为二维变量数组，并将内存中的重定向处理为第二个数组，这将是最方便的方法。

Sub Flip()
' Flip Macro
    Dim v As Long, val As Variant, vals As Variant
    Dim a As Long, b As Long, stp As Long

    stp = 16
    ReDim val(1 To stp, 1 To 1)

    With Worksheets("S&P 500 Constituents")
        With .Range(.Cells(2, "I"), .Cells(Rows.Count, "CM").End(xlUp))
            vals = .Value2
        End With
    End With

    With Worksheets("Sheet1")
        For a = LBound(vals, 1) To UBound(vals, 1)
            For b = LBound(vals, 2) To UBound(vals, 2) - stp Step stp
                For v = 1 To stp
                    val(v, 1) = vals(a, b - ((b > 1) * 3) + (v - 1))
                Next v
                .Cells(2, "D").Offset((a - 1) * stp, Int(b / stp)).Resize(stp, 1) = val
            Next b
        Next a

    End With

End Sub

我故意避免使用原生TRANSPOSE function，因为它的大小限制更适合.xls而不是.xlsx。提供循环重定向的数学是从示例代码的第一行派生的。

VBA转置多次

1 个答案: