合并单元格有没有更加好的方法，数据量大时反应太慢，会卡住

ykcbf1100

单元格合并，快速

1. Sub ykcbf()   '//2024.7.10    单元格合并,数组法
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim zrr(1 To 10000)
   
5.     Dim tm: tm = Timer
   
6.     With Sheets("Sheet1")
   
7.         r = .Cells(Rows.Count, 1).End(3).Row
   
8.         arr = .[a1].Resize(r, 2)
   
9.         For i = 2 To UBound(arr)
   
10.             If arr(i, 1) <> arr(i - 1, 1) Then m = m + 1: zrr(m) = Array(i, i)
    
11.             If i = r Then zrr(m)(1) = r
    
12.             If i < r Then
    
13.                 If arr(i, 1) = arr(i - 1, 1) And arr(i, 1) <> arr(i + 1, 1) Then zrr(m)(1) = i
    
14.             End If
    
15.         Next
    
16.         For x = 1 To m
    
17.             r1 = zrr(x)(0): r2 = zrr(x)(1)
    
18.             n = r2 - r1 + 1
    
19.             .Cells(r1, 1).Resize(n).Merge
    
20.         Next
    
21.     End With
    
22.     Application.ScreenUpdating = True
    
23.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
24. End Sub
    

复制代码

kyxfyzg

Private Sub CommandButton1_Click()
Dim irow As Integer, sh
Dim i As Integer, arr
arr = range("a1").CurrentRegion
Application.ScreenUpdating = False
Application.DisplayAlerts = False
irow = UBound(arr)
i = 3
sh = 2
Do While i <= irow
    If arr(i, 1) <> arr(i, 1) Then
        range(range("a" & sh), range("a" & i)).Merge  '单元格合并
        sh = i + 1
    End If
    i = i + 1
Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

dnvjfdeuff

ykcbf1100 发表于 2024-7-10 08:40
单元格合并，快速

谢谢大神们帮助