内容相同单元格后续列内容合并至一个单元格问题

透视合并 或 Vba整理

我先把它排成这样的格式

然后在后面输入“经理，女，25岁，4年”，然后鼠标放到下一行，按“ctrl+E”键，它就能自动填充后面的了

图片在5楼，文件在这里。alt+f8执行。
https://pan.baidu.com/s/1crfy7i8bjTDqIbuP-6Y61g

他这个例子的数字显得比较规则，实际情况怎样需要楼主提供详细模拟数据。

按照楼主模拟数据，结果放入G列，代码如下：
Sub Test_1019()
Dim arr, brr, temp(), dic As Object
Dim i&, j&, k&, t&, n&, r&, sr$
Set dic = CreateObject("Scripting.Dictionary")
r = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a2:e" & r)
For i = 1 To r - 1
dic(arr(i, 1)) = ""
Next
dic_keys = dic.keys
dic.RemoveAll
ReDim brr(0 To UBound(dic_keys), 1 To 2)
For j = 0 To UBound(dic_keys)
For i = 1 To r - 1
If arr(i, 1) = dic_keys(j) Then
n = n + 1
ReDim Preserve temp(1 To 4 * n)
For k = 1 To 4
temp(k + 4 * (n - 1)) = arr(i, k + 1)
Next
End If
Next
For t = 1 To 4 * n
dic(temp(t)) = ""
Next
dic1_keys = dic.keys
dic.RemoveAll
n = 0
brr(j, 1) = dic_keys(j)
sr = Replace(Join(dic1_keys, ","), ",,", ",")
If Right(sr, 1) = "," Then
brr(j, 2) = Left(sr, Len(sr) - 1)
Else
brr(j, 2) = sr
End If
Next
[g2].Resize(UBound(brr) + 1, 2) = brr
End Sub

textjoin函数