仅当数据是新的数据组/excel vba时，才将数据转换到新列

我在excel中有一列数据，可能包含超过2000行的数据。在该数据中，有一些数据组，我希望在每次找到新组时将其发送到新列的顶部。我已经研究了转置的特殊粘贴选项以及使用分隔符，但我只能将数据移动到一列上，而不能移动到顶部。我正在寻找一个解决方案，这是快速的，因为大量的数据，将需要分为新的列。我感谢你的帮助

下表显示了数据的外观

下面是我希望数据的外观

试试这个简单的代码

Sub splitRange()
Dim i As Long, j As Long, k As Long
Cells(1, 6) = Cells(1, 1)
Cells(1, 7) = Cells(1, 2)
j = 1
k = 6
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i - 1, 1) Then
        j = j + 1
        Cells(j, k) = Cells(i, 1)
        Cells(j, k + 1) = Cells(i, 2)
    Else
        k = k + 3
        j = 1
        Cells(j, k) = Cells(i, 1)
        Cells(j, k + 1) = Cells(i, 2)
    End If
Next i
End Sub

如果希望在单独的工作表中输出，请修改代码。我想让你用谷歌来了解它

---

我不得不做类似的事情。您也可以尝试以下代码：

Sub Move_Data()

    Application.ScreenUpdating = False

    Dim r  As Integer
    Dim StartRow As Integer
    Dim EndRow As Integer
    Dim ColA As Integer
    Dim vLastRow As Integer
    Dim vEnd As Integer

    r = 1
    StartRow = 1
    EndRow = 1
    ColA = 4
    vEnd = 1

    vLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

    Do Until Cells(r, 1) <> Cells(StartRow, 1)
        DoEvents
        r = r + 1
    Loop

    vEnd = r

    Do Until r > vLastRow

        DoEvents

        StartRow = r

        Do Until Cells(r, 1) <> Cells(StartRow, 1)
            DoEvents
            r = r + 1
        Loop

        EndRow = r - 1

        Range(Cells(StartRow, 1), Cells(EndRow, 2)).Select

        Selection.Copy

        Cells(1, ColA).Select

        ActiveSheet.Paste

        ColA = ColA + 3

    Loop

    r = vEnd + 1

    Range(Cells(vEnd, 1), Cells(vLastRow, 2)).ClearContents

    Cells(1, 1).Select

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

子移动_数据（）
Application.ScreenUpdating=False
作为整数的Dim r
Dim StartRow为整数
作为整数的Dim EndRow
整数形式
Dim vLastRow作为整数
作为整数的Dim vEnd
r=1
StartRow=1
EndRow=1
可乐=4
vEnd=1
vLastRow=Cells.Find（“*”，[A1]，.xlByRows，xlPrevious）.Row
直到单元格（r，1）单元格（StartRow，1）为止
多芬特
r=r+1
环
vEnd=r
直到r>vLastRow
多芬特
StartRow=r
直到单元格（r，1）单元格（StartRow，1）为止
多芬特
r=r+1
环
EndRow=r-1
范围（单元格（开始行，1），单元格（结束行，2））。选择
选择，复制
单元格（1，可乐）。选择
活动表。粘贴
可乐=可乐+3
环
r=vEnd+1
范围（单元格（vEnd，1），单元格（vLastRow，2））.ClearContents
单元格（1，1）。选择
Application.ScreenUpdating=True
MsgBox“完成”
端接头

听起来确实像是某些VBA的工作。但是，我们不会从头开始为您编写。向我们展示你在这方面付出的努力和研究，我们将帮助你走完最后一步。