数据转换，要求见截图（较急）

笨鸟飞不高

Sub AwTest()
    Dim i&, x&, r&, y%, c%, arr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    arr = Range("B2:E" & Cells(Rows.Count, 2).End(3).Row)
    ReDim brr(1 To UBound(arr) + 1, 1 To UBound(arr) + 1)
    r = 1: c = 1
    For i = 1 To UBound(arr)
        x = d(arr(i, 3))
        If x = 0 Then r = r + 1: d(arr(i, 3)) = r: brr(r, 1) = arr(i, 3): x = r
        y = d(arr(i, 4))
        If y = 0 Then c = c + 1: d(arr(i, 4)) = c: brr(1, c) = arr(i, 4): y = c
        brr(x, y) = IIf(brr(x, y) = "", arr(i, 1), brr(x, y) & "、" & arr(i, 1))
    Next
    [f21].Resize(r, c) = brr
End Sub