[已解决]请教老师，用VBA将A.B.C列有重复内容的单元格进行合并。效果请见 I - O 列

kekou123

请教老师，用VBA将A.B.C列有重复内容的单元格进行合并。效果请见 I -  O 列
单元格合并Book1.rar (7.85 KB, 下载次数: 13)

2012-9-1 17:07 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-9-1 17:15

1. Sub 合并()
   
2.     Dim i%, j%
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     For j = 1 To 3
   
6.         For i = Range("a65536").End(xlUp).Row - 1 To 3 Step -1
   
7.             If Cells(i, j) = Cells(i + 1, j) Then
   
8.                 Range(Cells(i, j), Cells(i + 1, j)).Merge
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     Application.DisplayAlerts = True
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

跳转到最佳答案楼层

hrpotter

1. Sub 合并()
   
2.     Dim i%, j%
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     For j = 1 To 3
   
6.         For i = Range("a65536").End(xlUp).Row - 1 To 3 Step -1
   
7.             If Cells(i, j) = Cells(i + 1, j) Then
   
8.                 Range(Cells(i, j), Cells(i + 1, j)).Merge
   
9.             End If
   
10.         Next
    
11.     Next
    
12.     Application.DisplayAlerts = True
    
13.     Application.ScreenUpdating = True
    
14. End Sub

复制代码

hwc2ycy

1. Sub s1()
   
2.     Dim i&
   
3.     Dim urg As Range
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     Dim j&
   
7.     For j = 1 To 3
   
8.         Set urg = (Cells(3, j))
   
9.         For i = 3 To Cells(2, j).End(xlDown).Row
   
10.             If Cells(i, j).Value = Cells(i + 1, j).Value Then
    
11.                 Set urg = Union(urg, Cells(i + 1, j))
    
12.             Else
    
13.                 urg.Merge
    
14.                 Set urg = Cells(i + 1, j)
    
15.             End If
    
16.         Next
    
17.     Next
    
18. End Sub

复制代码

hwc2ycy

hrpotter 发表于 2012-9-1 17:15

好方法，学习了。

从你的往下合并，推出往上合并，