连续复制数据并将它们分散在不同的列上

时间:2014-09-13 12:18:01

标签: excel vba excel-vba transpose

我的行数据如下:

Column A 
Datapoint1 
Datapoint2 
Datapoint3 
Datapoint4 

我可以转置,但结果将是这样的。

Column A   Column B   Column C 
Datapoint1 Datapoint2 Datapoint3 

我想要实现的是

Column A,   Column B, Column C, Column D, Column E, Column F, Column G 
Datapoint1, empty,    empty,    empty,    empty,    empty,    Datapoint 2 

Datapoint 3将出现在M列中。其间有5列。

大约有3,000个Datapoints需要转换成列(中间用5列分隔)。

1 个答案:

答案 0 :(得分:0)

您可以在下面使用此功能。我测试了3000件物品,它几乎立即运行。问题是在2732个项目之后,自Office 2013起Excel最大列数 16,384 时用完了行(请参阅Office 2010 Excel SpecificationsOffice 2013 Excel Specifications)。在下面的代码中,一旦它通过,它只是清除剩余的行并将语句打印到调试窗口。处理你想要的方式。

Sub TransposeIt()

    Const maxColumns As Integer = 16384

    On Error GoTo er

    Application.ScreenUpdating = False          '' shut off screen updating to speed up if possible

    Dim x As Range
    Set x = Range("A1", Range("A1").End(xlDown)) '' Selects all cells until there is a blank
                                                 '' if you might have blanks, then calculate the last row manually

    Dim c As Range, col As Integer, val As Variant
    For Each c In x.Cells
        val = c.Value '' so as not to overwrite A1
        c.Value = ""
        col = (c.row - 1) * 6 + 1
        If col > maxColumns Then '' max number of rows we can actually use is 2732
            Debug.Print "Out of Columns, clearing Row " & c.row '' do what you want at this point
        Else
            Cells(1, col).Value = val
        End If
    Next

ex:

    Application.ScreenUpdating = True
    Exit Sub

er:

    Debug.Print "An Error has occured: " & Err.Description
    Resume ex

End Sub