动态选择指定列后合并相邻相近相同单元格问题

yjwdjfqb

动态选择指定列后合并相邻相近相同单元格问题

1. Sub 选择列区域相同且相邻的单元格合并22()
   
2.     Dim rng As Range
   
3.     Dim I&, Col&, Fist, Last
   
4.     On Error Resume Next
   
5.     Set rng = Application.InputBox("请选择单列数据列！", Type:=8)
   
6.     If rng Is Nothing Then Exit Sub
   
7.     Set rng = Intersect(rng.Parent.UsedRange, rng)
   
8.     Col = rng.Column
   
9.     Fist = rng.Row
   
10.     Last = Fist + rng.Rows.Count - 1
    
11.     rng.Parent.Select
    
12.     Application.ScreenUpdating = False
    
13.     Application.DisplayAlerts = False
    
14.     For I = Last To Fist + 1 Step -1
    
15.         If Cells(I, Col) = Cells(I - 1, Col) Then
    
16.             Cells(I - 1, Col).Resize(2, 1).Merge
    
17.         End If
    
18.     Next
    
19.     rng.VerticalAlignment = xlCenter
    
20.     rng.HorizontalAlignment = xlCenter
    
21.     Application.ScreenUpdating = True
    
22.     Application.DisplayAlerts = True
    
23.     MsgBox "相同相邻单元格合并完成！"
    
24. End Sub
    
25. 
    

复制代码

选择列区域相同且相邻的单元格合并.rar (9.42 KB, 下载次数: 2)

2019-11-22 15:17 上传

点击文件名下载附件

请老师们帮修改下，这个代码，谢谢老师们了！

爱疯

    For I = Last To Fist + 1 Step -1
        If Cells(I, Col) <> "" Then
            If Cells(I, Col) = Cells(I - 1, Col) Then
                Cells(I - 1, Col).Resize(2, 1).Merge
            End If
        End If
    Next