Function ailist(r As Range)
    arr = r.Value
    Dim t()
    ReDim t(1 To UBound(arr))
        For i = 1 To UBound(arr)
            t(i) = arr(i, 1) & "% " & arr(i, 2)
        Next
        ailist = Join(t, ", ")
End Function


Sub ailist()
Dim t()
    For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        y = x
        Do While Cells(y + 1, 1) <> ""
            y = y + 1
        Loop
        arr = Range(Cells(x, 1), Cells(y, 2)).Value
            ReDim t(1 To UBound(arr))
                For i = 1 To UBound(arr)
                    t(i) = arr(i, 1) & "% " & arr(i, 2)
                Next
            Cells(x, 3) = Join(t, ", ")
            x = Cells(y, 1).End(xlDown).Row - 1
    Next
End Sub