宏在特定元素处拆分数据，并将其各个值粘贴到下一列

Question

如下图所示，image2中有三组数据，第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