合并数据内容相同的连续单元格(VBA)
[ V.S.林 原创,转载请注明出处 ]
Sub mergecell()
Dim rng1, rng2 As Range
Dim i, j As Long
On Error Resume Next
Application.DisplayAlerts = False
Set rng2 = Application.InputBox("选择单元格区域:", "合并连续相同内容单元格", , , , , , 8)
Set rng1 = Application.Intersect(ActiveSheet.UsedRange, rng2)
For i = 1 To rng1.Cells.Count + 1
For j = i + 1 To rng1.Cells.Count + 1
If rng1.Cells(i) <> rng1.Cells(j) Then
Range(rng1.Cells(i), rng1.Cells(j - 1)).Merge
Exit For
End If
Next
i = j - 1
Next
Application.DisplayAlerts = True
End Sub
V.S.EXCEL_VBA