相邻行单元格内容相同自动合并单元格（已解决）

djlin

请各位VBA高手帮忙：

相邻行单元格内容相同自动合并单元格，如附件所示

谢谢！！！

[ 本帖最后由 djlin 于 2010-3-20 11:43 编辑 ]

lb_bn

楼主可以看看这个帖

http://club.excelhome.net/thread-516474-1-1.html

zldccmx

      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2010-3-20 上午 11:11:53
Sub zldccmx()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Arr = [A1:A9]
    For i = 2 To UBound (Arr) - 1
        If Arr(i, 1) = Arr(i - 1, 1) Then
            For j = i + 1 To UBound (Arr)
                If Arr(j, 1) <> Arr(i, 1) Then Exit For
            Next
            Range ("A" & i - 1 & ":A" & j - 1).Merge: i = j
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[ 本帖最后由 zldccmx 于 2010-3-20 11:14 编辑 ]

djlin

非常感谢 lb-bn 的推荐,学习了!!

djlin

也非常感谢 老朽 的帮忙，您的程序也可以实现，谢谢！！！

lhx120824

原帖由 zldccmx 于 2010-3-20 11:12 发表
      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2010-3-20 上午 11:11:53
Sub zldccmx()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Arr ...

老朽的作品让人看的赏心悦目，简洁易懂。

lano

待学习，先用了

ice_spirit

zldccmx 发表于 2010-3-20 11:12
'撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2010-3-20 上午 11:11:53

C:\Documents and Settings\liuyongqiang\桌面\1.jpg
如果效果要达成如图示的结果该如何做呢，谢谢！

NewZealand

zldccmx 发表于 2010-3-20 11:12
'撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2010-3-20 上午 11:11:53

你好，如果需要合并的区域是A1：H9，怎么加一个循环语句呢？自己试了很多次都没能解决，现向老朽前辈请教。

NewZealand

自己想了想，测试了一下终于可以了
Sub zldccmx()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Arr = [A1:C14]    ‘要比数据区域多一行，不然不会合并最后一行的数据
    For k = 1 To 3
    A = Chr(k + 64)
        For i = 2 To UBound(Arr) - 1
            If Arr(i, k) = Arr(i - 1, k) Then
                For j = i + 1 To UBound(Arr)
                    If Arr(j, k) <> Arr(i, k) Then Exit For
                Next
                Range(A & i - 1 & ":" & A & j - 1).Merge: i = j
            End If
        Next
    Next

    Application.ScreenUpdating = True
   
End Sub