Sub 拆分合并单元格并填充()
Dim FindStr As String, Rng As Range, mRng As Range
Application.FindFormat.Clear
Application.FindFormat.MergeCells = True
With ThisWorkbook.Sheets("表名").Cells
Set Rng = .Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchFormat:=True)
If Rng Is Nothing Then MsgBox "没有合并单元格": Exit Sub
Set mRng = Rng
FindStr = Rng.Address
Do
Set Rng = .Find(What:="", After:=Rng, SearchFormat:=True)
Rng.Select
Selection.UnMerge
Selection.FormulaR1C1 = Rng
Loop While FindStr <> Rng.Address
End With
End Sub
Dim FindStr As String, Rng As Range, mRng As Range
Application.FindFormat.Clear
Application.FindFormat.MergeCells = True
With ThisWorkbook.Sheets("表名").Cells
Set Rng = .Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchFormat:=True)
If Rng Is Nothing Then MsgBox "没有合并单元格": Exit Sub
Set mRng = Rng
FindStr = Rng.Address
Do
Set Rng = .Find(What:="", After:=Rng, SearchFormat:=True)
Rng.Select
Selection.UnMerge
Selection.FormulaR1C1 = Rng
Loop While FindStr <> Rng.Address
End With
End Sub