将大型数据集拆分为列

Question

我有一个大型数据集，我已设法按以下格式安排作为示例：

A       A
One     1
Two     2
Three   3
Four    4
Five    5
Six     6
Seven   7
B       B
One     1
Two     2
Three   3
Four    4
Five    5
Six     6
C       C
One     1
Two     2
Three   3
Four    4
Five    5
Six     6
Seven   7
Eight   8

我想将数据拆分为单独的列...像这样：

A       A   B       B   C       C
One     1   One     1   One     1
Two     2   Two     2   Two     2
Three   3   Three   3   Three   3
Four    4   Four    4   Four    4
Five    5   Five    5   Five    5
Six     6   Six     6   Six     6
Seven   7               Seven   7
                        Eight   8

这是将数据转换为可用格式的最后步骤之一。我已经使用各种VBA宏将数据转换为第一种格式。我在下一个重要步骤遇到了障碍。我做了一些广泛的谷歌搜索，并没有能够提供正确的宏。谢谢您的帮助。

Answer 1

假设没有其他装饰，并且您的标题不仅仅是A，B或C，我还会使用以下宏。需要明确的是，这非常不灵活。它只有在你拥有与上面完全相同的设置时才有效，所以由你来应用我使用的逻辑并根据你的需要进行修改。

Sub NoFrills()

    Dim aRng As Range, bRng As Range, cRng As Range
    Dim endA As Long, endB As Long, endC As Long
    Dim aRngToCopy As Range, bRngToCopy As Range, cRngToCopy As Range
    Dim NextCol As Long, RngToCopy As Range

    Set aRng = Columns(1).Find(What:="Alpha")
    Set bRng = Columns(1).Find(What:="Beta")
    Set cRng = Columns(1).Find(What:="Charlie")

    'endA = bRng.Offset(-1, 0).Row 'Not really needed.
    endB = cRng.Offset(-1, 0).Row
    endC = cRng.End(xlDown).Row

    'Set aRngToCopy = Range(aRng, Cells(endA, 2)) 'Not really needed.
    Set bRngToCopy = Range(bRng, Cells(endB, 2))
    Set cRngToCopy = Range(cRng, Cells(endC, 2))

    Application.ScreenUpdating = False

    NextCol = aRng.End(xlToRight).Offset(0, 1).Column
    bRngToCopy.Cut Cells(1, NextCol)

    NextCol = aRng.End(xlToRight).Offset(0, 1).Column
    cRngToCopy.Cut Cells(1, NextCol)

    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With

End Sub

我的方法是提前确定需要切割并转换为水平格式的细胞的所有“块”。然后，我一次又一次地调用NextCol并粘贴到该单元格，继续确定需要定位的下一列。

当然，逻辑是你有更多的范围，你必须在某处（提示，提示）存储这些范围并在它们上面循环（更多提示，提示）。

请告诉我们这是否有帮助，或者至少指出您想要的方向。

<强>截图：

设置：

结果：