用于在特定元素处拆分数据的宏，并将其粘贴到下一列中的相应值

Question

如下图所示，我有3组数据在第1列中具有相同的元素（顺序可能不同），在第2列中具有不同的值。我需要一个宏来分割特定元素的数据（ A ）并相应地粘贴column3..column4..column5中相应元素的值，如image1所示。

这是预期的输出：

这是我目前的输入数据：

Answer 1

放手一搏。这假设每个部分都有一个A并用作部分分隔符

Public Sub Generate()
    Dim rng As Range
    Dim tmp As Variant
    Dim c, key
    Dim NoOfSets As Long
    Dim Dict As Object
    Dim i As Long, j As Long

    Set Dict = CreateObject("Scripting.Dictionary")
    Set rng = Range(Cells(1, 1), Cells(Cells(Rows.Count, "B").End(xlUp).Row, 2))
    NoOfSets = Application.CountIf(rng, "A")
    j = 1
    For i = 1 To rng.Rows.Count
        ReDim tmp(1 To NoOfSets)

        If Not Dict.exists(rng.Cells(i, 1).Value2) Then
            tmp(j) = rng.Cells(i, 2).Value2
            Dict.Add key:=rng.Cells(i, 1).Value2, Item:=tmp
        Else
            If rng.Cells(i, 1) = "A" Then j = j + 1
            tmp = Dict(rng.Cells(i, 1).Value2)
            tmp(j) = rng.Cells(i, 2).Value2
            Dict(rng.Cells(i, 1).Value2) = tmp
        End If
    Next i

    j = 0
    With Cells(1, 4)
        For Each key In Dict.keys
            .Offset(j, 0) = key
            Range(.Offset(j, 1), .Offset(j, UBound(Dict(key)))) = Dict(key)
            j = j + 1
        Next key
    End With
End Sub