excel合并相同的值

Sub CellsMerge()
' 一键批量合并相同单元格
' 快捷键: Ctrl+Shift+Q
If Selection.Count = 1 Or Selection.Columns.Count > 1 Then Exit Sub '如果只选择一个单元格或者选择了多列则退出
Dim row, col As Integer
col = Selection.Column
'使用Intersect避免选择整列造成的无效运算
firstrow = Intersect(Selection, ActiveSheet.UsedRange).row
lastrow = firstrow + Intersect(Selection, ActiveSheet.UsedRange).Rows.Count - 1
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For row = lastrow To firstrow Step -1
    If ActiveSheet.Cells(row, col).Value = ActiveSheet.Cells(row - 1, col).Value Then
        ActiveSheet.Cells(row - 1, col).Resize(2, 1).Merge
        With ActiveSheet.Cells(row - 1, col)
          .VerticalAlignment = xlCenter
          .HorizontalAlignment = xlCenter
        End With
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

转自：https://mp.weixin.qq.com/s?__biz=MzIwMDY4MjQ3NQ==&mid=2650691325&idx=1&sn=c85b2ba5fe380da1d0da4fc4fef23003&chksm=8ef38879b984016f59f3c37dcc7016a7e71b41255d4c165e64c52ec724e3fdaa816e395b7338&token=2007513612&lang=zh_CN#rd