[已解决]A，B,E,F,G,H,I列相临近相数据一样的自动合并，数据量大，求解。

che_dream

A，B,E,F,G,H,I列相临近相数据一样的自动合并，数据量大，求解。谢谢啦。。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-5 19:58

(, 下载次数: 18)

上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

1. Sub 合并1()
   
2.     Dim i As Long, j As Long, k As Long
   
3.     Dim rg As Range
   
4.     Dim iArr
   
5.     Dim iRow As Long
   
6.     If [a5] = "" Then Exit Sub  '避免空数据情况
   
7.     iRow = [a5].End(xlDown).Row
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.     iArr = Array(1, 2, 5, 6, 7, 8, 9)
    
11.     For i = 0 To UBound(iArr)
    
12.         k = iArr(i)
    
13.         For j = 5 To iRow
    
14.             Set rg = Cells(j, k)
    
15.             Do While Cells(j, k) = Cells(j + 1, k)
    
16.                 j = j + 1
    
17.             Loop
    
18.             Set rg = Range(rg, Cells(j, k))
    
19.             rg.Merge
    
20.         Next
    
21.     Next
    
22. End Sub

复制代码

hwc2ycy

F列日期数据是要合并的嘛？
看你的源表演示里，F列没有合并。

hwc2ycy

刚开始发的代码，没注意到行的问题了，之前本来是想用数组的，结果后面没用了，所以行起点就不对。
后来才发现的。
再改一个上来，数组还没派上用场，

hwc2ycy

1. Sub 合并2()
   
2.     Dim arr
   
3.     Dim i As Long, j As Long, k As Long 'I代表列数组，J代表行,K代表列
   
4.     Dim rg As Range     '合并RANGE
   
5.     Dim iArr    '需要合并的列号
   
6.     Dim iRow    '数据行数
   
7.     Application.ScreenUpdating = False
   
8.     Application.DisplayAlerts = False
   
9.     iArr = Array(1, 2, 5, 6, 7, 8, 9)
   
10.     arr = Range("a5:i" & [a5].End(xlDown).Row).Value
    
11.     If [a5] = "" Then Exit Sub  '避免空数据情况
    
12.     iRow = UBound(arr)
    
13.     For i = 0 To UBound(iArr)
    
14.         k = iArr(i)
    
15.         For j = 1 To iRow
    
16.             If j = iRow Then Exit For
    
17.             Set rg = Cells(j + 4, k)        '行数据与数组中的行数相差为4
    
18.             Do While arr(j, k) = arr(j + 1, k)
    
19.                 j = j + 1
    
20.                 If j = iRow Then Exit Do
    
21.             Loop
    
22.             Set rg = Range(rg, Cells(j + 4, k))
    
23.             rg.Merge
    
24.         Next
    
25.     Next
    
26. End Sub

复制代码

che_dream

hwc2ycy 发表于 2012-10-5 12:26

运行好像没有反应啊。。。。。

hwc2ycy

你把你数据的图截个我看看，是跟附件一样的嘛？

hwc2ycy

我这测试了你的样本数据，合并是成功的。

che_dream

hwc2ycy 发表于 2012-10-5 13:34
我这测试了你的样本数据，合并是成功的。

确实不行，帮我看看。。。。

hwc2ycy

che_dream 发表于 2012-10-5 14:02
确实不行，帮我看看。。。。

你这个表里前面有二行合并的，我帮你把合并的取消，还原数据的本来面目给你试试。