前言｜职场实例
今天，小编在工作中遇到一个非常实用的技巧，总结成文章后分享给小伙伴们，希望大家可通过此技巧来提高自己的职场工作效率。
如下图所示：
下图左表中A列为日期列，我们观察到日期列中有很多相同的日期，现在我们想要将相邻的相同日期的单元格进行合并单元格，形成右表E列日期列的效果。
同样的道理，通过将日期列相同日期单元格进行合并单元格后，我们仍可以逆向操作，回到原始状态。
如下图所示：
我们想要将左表中A列日期列相同日期合并后的单元格，批量取消合并单元格，并快速填充全部单元格内容，最后形成右表E列日期列的效果。
操作1｜合并单元格
首先，我们右击工作表名称标签，点击“查看代码”命令（或按下快捷键Alt+F11键），进入VBA代码编辑录入窗口。将下方的一段VBA代码复制粘贴进来。
然后点击“运行-运行子过程/用户窗体”命令，会随即弹出一个“只能选择单列”的对话框。然后我们设置“请选择需要合并单元格的区域”，这时候我们将光标点击定位在区域选择框内，回到Excel表格，选择我们需要合并的单元格区域：A2:A10单元格数据区域。最后点击“确定”按钮。我们发现A列日期列相同日期的单元格就批量合并完成了。
合并单元格代码如下：
Sub RngMerge()
Dim Rng As Range, Cell As Range, Rg As Range
On Error Resume Next
Set Rng = Application.InputBox("请选择需要合并单元格的区域", "只能选取单列", ActiveCell.Address, , , , , 8)
If Rng Is Nothing Then MsgBox "选择的区域无效!!", 65, "提示": Exit Sub
If Rng.Columns.Count > 1 Then MsgBox "只能选择一列", 65, "错误": Exit Sub
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Rg = Rng(1)
For Each Cell In Rng.Offset(1).Resize(Rng.Rows.Count, 1)
If Cell <> Cell.Offset(-1, 0) Then
With Range(Rg, Cell.Offset(-1))
.Merge
.HorizontalAlignment = -4108
.VerticalAlignment = -4108
End With
Set Rg = Cell
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
操作2｜取消合并单元格并批量填充
首先，我们右击工作表名称标签，点击“查看代码”命令（或按下快捷键Alt+F11键），进入VBA代码编辑录入窗口。将下方的一段VBA代码复制粘贴进来。
然后点击“运行-运行子过程/用户窗体”命令，会随即弹出一个“只能选择单列”的对话框。然后我们设置“请选择需要取消合并单元格的区域”，这时候我们将光标点击定位在区域选择框内，回到Excel表格，选择我们需要取消合并的单元格区域：A2:A10单元格数据区域。最后点击“确定”按钮。我们发现A列日期列相同日期合并后的单元格就批量实现了取消合并单元格并批量填充完整了，即实现了逆向操作。
取消合并单元格代码如下：
Sub RngUnMerge()
Dim Rng As Range, Cell As Range
On Error Resume Next
Set Rng = Application.InputBox("请选择需要取消合并单元格的区域", "只能选取单列", ActiveCell.Address, , , , , 8)
If Rng Is Nothing Then MsgBox "选择的区域无效!!", 65, "提示": Exit Sub
If Rng.Columns.Count > 1 Then MsgBox "只能选择一列", 65, "错误": Exit Sub
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Cell In Rng
If Cell.MergeArea.Count > 1 Then
With Cell.MergeArea
.UnMerge
.Value = Cell.Value
.Borders.LineStyle = 1
End With
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
