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

djlin · 发表于 2010-3-20 09:59

请各位VBA高手帮忙：

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

谢谢！！！

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

lb_bn · 发表于 2010-3-20 10:54

楼主可以看看这个帖

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

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 = [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 · 发表于 2010-3-20 11:36

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

djlin · 发表于 2010-3-20 11:41

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

lhx120824 · 发表于 2010-6-16 17:38

原帖由 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 · 发表于 2012-6-9 14:03

待学习，先用了

ice_spirit · 发表于 2012-7-1 09:48

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

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

NewZealand · 发表于 2013-10-29 16:40

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

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

NewZealand · 发表于 2013-10-29 18:26

自己想了想，测试了一下终于可以了
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

		自动登录	找回密码
密码			免费注册

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

评分