我要的其实是“拆分，而且每个格都填原来的字符串”，借鉴你的例子实现了，但是同时对多个合并后的格子（每个都是由几个格子合并成的），效果非预期

Sub tt() '合并
For Each vcell In Selection.Cells
Value = Value + vcell.FormulaR1C1
Next vcell

Selection.Merge
Selection.FormulaR1C1 = Value

End Sub


Sub ss() '拆分，只对一个格子（由几个格子合并成的）有效

s = Selection.FormulaR1C1

Selection.UnMerge

For Each vcell In Selection.Cells
vcell.FormulaR1C1 = s
Next vcell

'Selection.UnMerge
'Selection.FormulaR1C1 = Value

End Sub