let
    from = Excel.CurrentWorkbook(){[Name="Таблица13"]}[Content],
    gr=Table.Group(from,"Дата",{{"Товар",(x)=>Text.Combine(List.Distinct(x[Товар])," ")},
                                {"Цена",(x)=>x[Цена]}}),
    to=Table.SplitColumn(gr,"Цена",(x)=>x)
in
   to

Function СПЕЦТРАНСП(iRng As Range, Optional iDlm$ = " ")
Dim arr(), newArr(), iTmp()
Dim I&, J&, N&
arr = iRng.Value
Set dic = CreateObject("Scripting.Dictionary")
ReDim newArr(1 To UBound(arr, 1), 1 To 3)
For I = LBound(arr, 1) To UBound(arr, 1)
  If arr(I, 1) = 1 Then
    N = N + 1
    For J = 1 To 3: newArr(N, J) = arr(I, J + 1): Next
  Else
    If UBound(newArr, 2) < J Then ReDim Preserve newArr(1 To UBound(newArr, 1), 1 To UBound(newArr, 2) + 1)
    newArr(N, 2) = newArr(N, 2) & iDlm & arr(I, 3)
    newArr(N, J) = arr(I, 4)
    J = J + 1
  End If
Next
ReDim iTmp(1 To N, 1 To UBound(newArr, 2))
For I = 1 To N
  For J = 1 To UBound(newArr, 2)
    iTmp(I, J) = newArr(I, J)
  Next
Next
СПЕЦТРАНСП = iTmp
End Function