merge các ô có giá trị như nhau

[viettuan49a]

tôi có một bài về merge mà chưa có lời giải.
Mong các anh chị giúp đỡ.

Nhân thể tôi muốn hỏi:
có câu lệnh nào để macro delete chạy nhanh hơn không?
tôi đang dùng câu lệnh như sau để xóa các dòng theo điều kiện:

Dim n, i
n = [au4000].End(xlUp).Row
For i = n To 2301 Step -1
If Range("au" & i).Value <> "cong" Then Range("p" & i).EntireRow.Delete
If Range("bc" & i).Value = 0 Then Range("p" & i).EntireRow.Delete
Next i
cám ơn các anh chị

 

[dhn46]

Bạn dưng auto fillter sẽ nhanh hơn đấy
Bạn thủ code này nhé rồi tùy biến chỉnh lại cho phù hợp

Sub xoa()

[au1].AutoFilter Field:=1, Criteria1:="<>công"
Row("2:2310").Delete Shift:=xlUp
[au1].AutoFilter Field:=1

[bc1].AutoFilter Field:=1, Criteria1:="<>công"
Row("2:2310").Delete Shift:=xlUp
[bc1].AutoFilter Field:=1

End Sub

 

[viettuan49a]

mình sẽ thử cách xóa của bạn.
còn lệnh phá ô ra sao nhỉ
thank

 

[dhn46]

Bạn dùng cái mày để merg:
Sub Button1_Click()
Dim i, m, k As Integer
m = 0
Application.DisplayAlerts = False
For i = 2 To 14
If Cells(i, 1) = Cells(i - 1, 1) Then
m = m + 1
Else
Range(Cells(i - m - 1, 1), Cells(i - 1, 1)).Merge

m = 0
End If
If i = 14 And m > 0 Then
Range(Cells(i - m, 1), Cells(i, 1)).Merge
End If
Next
Application.DisplayAlerts = True
End Sub