excel 合并相同内容的单元格 vba

合并数据内容相同的连续单元格（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