"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel

[minhbinhdinh]

chào mọi người
mình có thử thủ tục "thủ tục để xóa dòng trống " trong sách Lập trình VBA trong Excel của a PTH như sau :
Sub DeleteEmptyRows()
Dim i As Integer
Dim FirstRow As Integer, LastRow As Integer, UsedRows As Integer
Application.ScreenUpdating = False
'xác định dòng đầu tiên có chứa dữ liệu
FirstRow = ActiveSheet.UsedRange.Row
'xác định số hàng có chứa dữ liệu
UsedRows = ActiveSheet.UsedRange.Rows.Count
'xác định hàng cuối có chứa dữ liệu
LastRow = FirstRow - 1 + UsedRows
For i = LastRow To step - 1 'lùi từng hàng lên trên
'xóa hàng nếu tổng số ô trông hàng có chứa dữ liệu bằng 0(hàng rỗng)
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
kết quả là xóa luôn sheet đó luôn.Mình chưa hiểu nó hoạt động như thế nào.
Mong mọi người chỉ giáo

 

[Locdulieu]

Em thử dùng code Sub xoa cua anh Quang Hải, quá tuyệt về tốc độ so với cái code của em, cảm ơn Anh thật nhiều...

 

[Quang_Hải]

Chổ này em ngoài cách dùng "Or" thì còn cách nào nữa không bác Cò già, xin chỉ giáo cho em vài chiêu để em hiểu thêm ít nhiều....Xin cảm ơn.

Code này mình thấy ổn rồi mà

 

[Locdulieu]

Em thử dùng code Sub xoa cua anh Quang Hải, quá tuyệt về tốc độ so với cái code của em, cảm ơn Anh thật nhiều...

 

[Locdulieu]

Trong code anh viết:
Cells(r, 5).EntireRow.Delete
là xóa cho hàng r cột E sao nó lại xóa luôn cho các cột khác ( F và G) được Anh giải thich giúp em chỗ này với....
Thanks Anh

 

[Quang_Hải]

Trong code anh viết:
Cells(r, 5).EntireRow.Delete
là xóa cho hàng r cột E sao nó lại xóa luôn cho các cột khác ( F và G) được Anh giải thich giúp em chỗ này với....
Thanks Anh

Cells(r, 5).EntireRow.Delete
Entirerow.delete là chọn cả dòng và xoá

 

[Locdulieu]

Dòng lệnh:
If Cells(r, 5).Font.Bold = 0 Then
Có nghĩa là nếu giá trị trong cột 5 không được tô đậm đúng không Anh?

 

[Quang_Hải]

Chính xác là như thế
True=1
Fasle=0

Tại mình hơi lười nên viết như thế.

 

[concogia]

Dòng lệnh:
If Cells(r, 5).Font.Bold = 0 Then
Có nghĩa là nếu giá trị trong cột 5 không được tô đậm đúng không Anh?

Viết giá trị trong cột 5 là không chính xác
Cells(r,5) ==> xác định cell có địa chỉ: Hàng= giá trị của biến r & Cột = cột thứ 5 ( cột E)
Thân

 

[haonlh]

Code này mình thấy ổn rồi mà

cái
Sub cc

của bạn không xóa được hết mọi hàng có ô đậm. Nếu chạy thêm một vài lần thì xóa hết.

Chắc do quá trình FOR (duyệt) từ đầu, khi xóa 1 hàng, hàng dưới dồn lên trở thành hàng đang duyệt, và FOR không duyệt lại từ đầu, nếu ô đầu tiên đậm thì không bị xử lý. Nên nếu mọi ô sau không đậm thì hàng này bị bỏ qua

 

[Quang_Hải]

Theo yêu cầu thì dòng nào có 1 trong 3 cell in đậm thì không xóa, mình xem lại code thấy ổn rồi mà

 

[Locdulieu]

For r = [g65536].End(3).Row To 6 Step -1

cho em hỏi ý nghĩa con số 3 là gì vậy anh, em sửa con số này là code báo lỗi, thanks Anh.

 

[Quang_Hải]

1 là sang trái, 2 là sang phải, 3 là lên trên, 4 là xuống dưới

 

[TrungChinhs]

cho em hỏi ý nghĩa con số 3 là gì vậy anh, em sửa con số này là code báo lỗi, thanks Anh.[/QUOTE

Muốn biết 1 2 3 4 trong End là gì bạn xem file sau.

 

[Locdulieu]

Em tăng số cột có chữ tô màu lên 7 cột thì code , với số dòng là 6500 dòng thì code sau:
'Delete Data not Bold da duoc chon truoc do
Sub short_data()
Dim erow As Long
Application.ScreenUpdating = 0
For erow = [J10000].End(3).Row To 6 Step -1
If Cells(erow, "D").Font.Bold = 0 And Cells(erow, "E").Font.Bold = 0 And Cells(erow, "F").Font.Bold = 0 And Cells(erow, "G").Font.Bold = 0 And Cells(erow, "H").Font.Bold = 0 And Cells(erow, "I").Font.Bold = 0 And Cells(erow, "J").Font.Bold = 0 Then
Cells(erow, "A").EntireRow.Delete
End If
Next
End Sub



Mất đến gần 5 phút mới chạy xong..
Anh có thể chỉ giúp cách làm cho nó chạy nhanh hơn tí được không Anh? Thanks anh thật nhiều...

 

[viehoai]

Em tăng số cột có chữ tô màu lên 7 cột thì code , với số dòng là 6500 dòng thì code sau:
'Delete Data not Bold da duoc chon truoc do
Sub short_data()
Dim erow As Long
Application.ScreenUpdating = 0
For erow = [J10000].End(3).Row To 6 Step -1
If Cells(erow, "D").Font.Bold = 0 And Cells(erow, "E").Font.Bold = 0 And Cells(erow, "F").Font.Bold = 0 And Cells(erow, "G").Font.Bold = 0 And Cells(erow, "H").Font.Bold = 0 And Cells(erow, "I").Font.Bold = 0 And Cells(erow, "J").Font.Bold = 0 Then
Cells(erow, "A").EntireRow.Delete
End If
Next
End Sub

View attachment 83452

Mất đến gần 5 phút mới chạy xong..
Anh có thể chỉ giúp cách làm cho nó chạy nhanh hơn tí được không Anh? Thanks anh thật nhiều...

Bạn sửa câu lệnh If với nhiều And như thế bằng

If Range("A" & erow & ":J" & erow).Font.Bold = False Then

Và cuối Sun trả về cập nhật màn hình

Application.ScreenUpdating =True

 

[Quang_Hải]

Sử dụng If .. then
If ... then
....
end if
end if

sẽ nhanh hơn and... rất nhiều

 

[Locdulieu]

Bạn sửa câu lệnh If với nhiều And như thế bằng
PHP Code:
If Range("A" & erow & ":J" & erow).Font.Bold = False Then


Và cuối Sun trả về cập nhật màn hình
PHP Code:

Application.ScreenUpdating =True

Em đã sửa code lại cho gọn nhưng tốc độ chạy code vẫn không cải thiện được Anh ơi,
Có cách nào cho nó chạy khoảng 1 phút thôi được không Anh, xin các Anh Chị giúp em với...

 

[Quang_Hải]

Thử thế này xem, khoảng 10 giay

Start = Timer
Application.ScreenUpdating = 0
For r = 6 To [j65536].End(3).Row
For c = 4 To 10
If Cells(r, c).Font.Bold = True Then Cells(r, 11) = 1
Next
Next
Set data = Range([a5], [j65536].End(3).Offset(, 1))
data.AutoFilter 11, ""
data.Offset(1).EntireRow.Delete
AutoFilterMode = False
[k:k].Clear
Application.ScreenUpdating = 1
MsgBox Timer - Start

 

[tanthieuhoa]

Em nghĩ Anh Quanghai có thể thay:

Thử thế này xem, khoảng 10 giay
....
Start = Timer
Application.ScreenUpdating = 0
For r = 6 To [j65536].End(3).Row
For c = 4 To 10
If Cells(r, c).Font.Bold = True Then Cells(r, 11) = 1
Next
Next
...

Bằng

.....
Dim rng As Range
Application.ScreenUpdating = 0
i = 4
For Each rng In sheet1.Range("F4:J" & sheet1.[j65000].End(3).Row)
If rng.Font.Bold = True Then sheet1.Cells(i, 11) = 1
i = i + 1
Next rng
....

Thì sẽ cải thiện thêm một chút tốc độ.
Có thể viết rõ địa chỉ (Range => Sheet1.range) để tránh sai lệch khi chạy code. Thân.

 

[Quang_Hải]

Em nghĩ Anh Quanghai có thể thay:

Bằng

.....
Dim rng As Range
Application.ScreenUpdating = 0
i = 4
For Each rng In sheet1.Range("F4:J" & sheet1.[j65000].End(3).Row)
If rng.Font.Bold = True Then sheet1.Cells(i, 11) = 1
i = i + 1
Next rng
....

Thì sẽ cải thiện thêm một chút tốc độ.
Có thể viết rõ địa chỉ (Range => Sheet1.range) để tránh sai lệch khi chạy code. Thân.

Hic code của bạn hình như chưa đúng cái vụ i=i+1