Sub demo()
Dim lastRow&, tempNum%, str$, i&
lastRow = Cells(Rows.Count, 3).End(3).Row
For i = lastRow To 2 Step -1
tempNum = Cells(i, 2).MergeArea.Rows.Count
str = Cells(i, 3) & "," & str
If Len(Cells(i, 2)) Then
Cells(i, 3).Resize(tempNum).Merge
Cells(i, 3) = Left(str, Len(str) - 1): str = ""
End If
Next i
End Sub
![](http://tiebapic.baidu.com/forum/w%3D580/sign=78fe0fd824d9f2d3201124e799ec8a53/e8448bd4b31c8701a28182df617f9e2f0708ff8f.jpg?tbpicau=2024-09-18-05_d25214e3c1443f21e19e2063f28a801b)