[已解决]还是合并单元格的问题

cumtclmk123

最后一行第1列如果是文字,就做为序号给更新了,怎么保留呢

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-12 09:08

1. Sub Macro1()
   
2. Dim i&, j%, s&
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Set rng = Cells(5, 3)
   
6. For i = 6 To Range("a65536").End(xlUp).Row
   
7.     If Cells(i, 3) = Cells(i - 1, 3) Then
   
8.         Set rng = Union(rng, Cells(i, 3))
   
9.     Else
   
10.         s = s + 1
    
11.         x = Application.Sum(rng.Offset(0, 3))
    
12.         For j = -2 To 3
    
13.             If j = 0 Then j = j + 1
    
14.             rng.Offset(0, j).Merge
    
15.         Next
    
16.         rng.Merge
    
17.         rng.Offset(0, -2) = s
    
18.         rng.Offset(0, 3) = x
    
19.         Set rng = Cells(i, 3)
    
20.     End If
    
21. Next
    
22. Application.DisplayAlerts = True
    
23. Application.ScreenUpdating = True
    
24. End Sub

复制代码

跳转到最佳答案楼层

雪舞子

1. Sub test()
   
2.     Dim i%, j%
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     For i = [e65536].End(3).Row To 5 Step -1
   
6.         If Cells(i, 3).Value = Cells(i - 1, 3).Value Then
   
7.             For j = 1 To 6
   
8.                 Range(Cells(i, j), Cells(i - 1, j)).Merge
   
9.             Next
   
10.         End If
    
11.     Next
    
12.     j = 0
    
13.     For i = 5 To [e65536].End(3).Row
    
14.         If Cells(i, 1) <> "" Then j = j + 1: Cells(i, 1) = j
    
15.     Next
    
16.     Application.DisplayAlerts = True
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

评价表(合并前).rar (8.72 KB, 下载次数: 6)

2015-3-12 08:06 上传

点击文件名下载附件

dsmch

1. Sub Macro1()
   
2. Dim i&, j%, s&
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Set rng = Cells(5, 3)
   
6. For i = 6 To Range("a65536").End(xlUp).Row
   
7.     If Cells(i, 3) = Cells(i - 1, 3) Then
   
8.         Set rng = Union(rng, Cells(i, 3))
   
9.     Else
   
10.         s = s + 1
    
11.         x = Application.Sum(rng.Offset(0, 3))
    
12.         For j = -2 To 3
    
13.             If j = 0 Then j = j + 1
    
14.             rng.Offset(0, j).Merge
    
15.         Next
    
16.         rng.Merge
    
17.         rng.Offset(0, -2) = s
    
18.         rng.Offset(0, 3) = x
    
19.         Set rng = Cells(i, 3)
    
20.     End If
    
21. Next
    
22. Application.DisplayAlerts = True
    
23. Application.ScreenUpdating = True
    
24. End Sub

复制代码

cumtclmk123

谢谢,非常好.问题解决了,但是看不懂