合并连续相同单元格的代码

lrlxxqxa

A列是各个部门信息，其中很多是连续重复的，如何快捷的将它们合并呢？

1. Sub MergeCells()
   
2. Dim lastRow As Integer
   
3. Dim i As Integer
   
4. Application.DisplayAlerts = False
   
5. With ActiveSheet
   
6. lastRow = .Range("A65536").End(xlUp).Row '获得A列最后一个有数据的行
   
7. For i = lastRow To 2 Step -1
   
8. If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
   
9. .Range(.Cells(i - 1, 1), .Cells(i, 1)).Merge
   
10. End If
    
11. Next
    
12. End With
    
13. Application.DisplayAlerts = True
    
14. End Sub

复制代码