"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel (1 người xem)

minhbinhdinh · 24/9/09

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

ndu96081631 · 24/9/09

minhbinhdinh đã viết:
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

Làm gì có vụ xóa luôn sheet chứ ---> Bạn đưa nguyên file + Code lên đây thử xem!
Code này tôi sửa lại như sau:

PHP:

Sub DeleteEmptyRows()
  Dim i As Long
  Application.ScreenUpdating = False
  With Sheet1.UsedRange
    For i = .Rows.Count To 1 Step -1
      If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
        .Cells(i, 1).EntireRow.Delete
      End If
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

minhbinhdinh · 24/9/09

thành thật xin lỗi mọi người.
1) Tôi lộn với " thủ tục xóa sheet rỗng" ở trang bên cạnh . Nhưng mà thủ tục này nó cũng không xóa được dòng rỗng .
2) Còn "thủ tục xóa sheet rỗng " này thì thế nào đó : Nó xóa sheet có dữ liệu chứ không phải xóa sheet rỗng.trước khi xóa xuất hiện thông báo : "Data may exist in the sheet(s) selected for deletion.To pertmanently delete the data ,press Delete"
3) nhờ anh ndu, trung chinh và .....xem giúp " tự động khóa vùng data " .tôi đang cần giải quyết vấn đề này gấp 1 tí .
Cảm ơn mọi người.

ndu96081631 · 24/9/09

minhbinhdinh đã viết:
thành thật xin lỗi mọi người.
1) Tôi lộn với " thủ tục xóa sheet rỗng" ở trang bên cạnh . Nhưng mà thủ tục này nó cũng không xóa được dòng rỗng .
2) Còn "thủ tục xóa sheet rỗng " này thì thế nào đó : Nó xóa sheet có dữ liệu chứ không phải xóa sheet rỗng.trước khi xóa xuất hiện thông báo : "Data may exist in the sheet(s) selected for deletion.To pertmanently delete the data ,press Delete"
3) nhờ anh ndu, trung chinh và .....xem giúp " tự động khóa vùng data " .tôi đang cần giải quyết vấn đề này gấp 1 tí .
Cảm ơn mọi người.

Xóa sheet rổng thì cần gì duyệt qua các cells
Vầy nè:

PHP:

Sub xoasheetrong()
  Dim Ws As Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  For Each Ws In ThisWorkbook.Worksheets
    If WorksheetFunction.CountA(Ws.Cells) = 0 Then
      Ws.Delete
    End If
  Next
  Application.DisplayAlerts = True
End Sub

Nói chung là tạm dùng được!

PhanTuHuong · 24/9/09

ndu96081631 đã viết:
Xóa sheet rổng thì cần gì duyệt qua các cells
Vầy nè:

PHP:

Sub xoasheetrong() Dim Ws As Worksheet On Error Resume Next Application.DisplayAlerts = False For Each Ws In ThisWorkbook.Worksheets If WorksheetFunction.CountA(Ws.Cells) = 0 Then Ws.Delete End If Next Application.DisplayAlerts = True End Sub

Nói chung là tạm dùng được!

Em bổ sung thêm nữa:

Mã:

Sub xoasheetrong()
  Dim Ws As Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  For Each Ws In ThisWorkbook.Worksheets
    If IsEmpty(Ws.UsedRange) Then
      Ws.Delete
    End If
  Next
  Application.DisplayAlerts = True
End Sub

nghiaquangtran · 26/9/09

Nếu mình muốn xóa dòng trống nhưng chỉ có những vùng có nhiều hơn 3 dòng trống liền nhau thì xóa và vẫn giữ lại 3 dòng trống
...cụ thể là mình có nhiều table data nằm cách nhau, mình muốn cắt bỏ dòng trống sao cho mỗi table nằm cách nhau 3 dòng trống.

Cám ơn

ndu96081631 · 26/9/09

nghiaquangtran đã viết:
Nếu mình muốn xóa dòng trống nhưng chỉ có những vùng có nhiều hơn 3 dòng trống liền nhau thì xóa và vẫn giữ lại 3 dòng trống
...cụ thể là mình có nhiều table data nằm cách nhau, mình muốn cắt bỏ dòng trống sao cho mỗi table nằm cách nhau 3 dòng trống.

Cám ơn

Theo ý kiến của cá nhân tôi: Bạn không nên bố trí dử liệu theo kiểu vậy ---> 2 bảng khác nhau lại nằm cùng 1 cột? Mai này sao quản lý dử liệu?
- Một là gộp chúng lại với nhau
- Hai là chuyển từng bảng sang từng sheet riêng

nghiaquangtran · 26/9/09

ndu96081631 đã viết:
Theo ý kiến của cá nhân tôi: Bạn không nên bố trí dử liệu theo kiểu vậy ---> 2 bảng khác nhau lại nằm cùng 1 cột? Mai này sao quản lý dử liệu?
- Một là gộp chúng lại với nhau
- Hai là chuyển từng bảng sang từng sheet riêng

Cám ơn ndu

Bảng sl của mình không phải là sl thô...

Mình dùng các soft khác (SPSS, Epidata...) để xử lý sl và chạy các ứng dụng phân tích thống kê và xuất kết quả ra excel ở dạng các bảng chéo nhiều hàng và nhiều cột, một số phần mềm khi dán data vào excel đã để các bảng sl này cách nhau rất xa (khoảng 20 dòng), nên đôi khi mình phải tự delete những dòng trống này thủ công để các bảng biểu này nằm gần nhau tiện cho việc phân tích sl, nhưng khi làm công việc phân tích thống kê đòi hỏi phải có nhiều bảng biểu sl thì làm thủ công cắt bỏ dòng trống rất mất thời gian.

joga7785 · 8/10/09

Hay quá. Mình vừa dịp cần dùng 2 cái thủ tục này.

Sub DeleteEmptyRows()
Dim i As Long
Application.ScreenUpdating = False
With Sheet1.UsedRange
For i = .Rows.Count To 1 Step -1
If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub xoasheetrong()
Dim Ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
For Each Ws In ThisWorkbook.Worksheets
If IsEmpty(Ws.UsedRange) Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

joga7785 · 8/10/09

Sub DeleteEmptyRows()
Dim i As Long
Application.ScreenUpdating = False
With Sheet1.UsedRange
For i = .Rows.Count To 1 Step -1
If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub xoasheetrong()
Dim Ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
For Each Ws In ThisWorkbook.Worksheets
If IsEmpty(Ws.UsedRange) Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

giamngucgames · 14/10/09

Sheet trống thì xóa được còn dòng thì không nhờ các bạn xem lại giúp

ptlong04x1 · 14/10/09

giamngucgames đã viết:
Sheet trống thì xóa được còn dòng thì không nhờ các bạn xem lại giúp

Mình thấy các code trên đã giải quyết vấn đề này rồi, xem lại đi bạn.

heo205 · 27/10/09

Mấy anh, chị ơi mấy cái code này minh sẽ nhập vào đâu ha.........

Locdulieu · 31/5/12

Em làm được code chạy mà vẫn không hiểu tại sao...
AC giải thích dùm em chỗ này nhé...
Sub To_mau_nen()
With Sheet2.UsedRange
For i = .Rows.Count To 6 Step -1
If Cells(i, 5).Font.Bold Or Cells(i, 6).Font.Bold Or Cells(i, 7).Font.Bold Then
i = i
Else
Rows(i).Delete

End If
Next
End With
End Sub
Dòng chữ màu xanh khi điều kiện chọn thỏa mãn là chữ tô đậm thì ---> giữ lại không xóa (mà ko biết dùng lệnh gì) đành ghi: " i=i "
còn ko thỏa mãn đều kiện thì xóa là Ok rùi...
AC giải thích giúp em chỗ này nhé...Xin cảm ơn thật nhiều
Em gửi file lên ...

Quang_Hải · 31/5/12

viết thế này cũng xoá được dòng có ô in đậm, muốn ngược lại thi sửa True thành False

For Each cell In [e6:g60]
If cell.Font.Bold = True Then cell.EntireRow.Delete
Next

Locdulieu · 31/5/12

For Each cell In [e6:g60]
If cell.Font.Bold = True Then cell.EntireRow.Delete
Next

Em sửa lại code theo anh nó lại xóa các dòng được tô đậm chứ không xóa các dòng không được tô đậm.
Ý em là muôn xóa các dòng không có chữ tô đậm, nhưng không hiểu về Vba lắm nên viết dài dòng và khó hiểu.
Anh có thể sửa code theo file em gửi và gửi lại giúp em được không,xin cảm ơn anh thật nhiều.

.

Locdulieu · 31/5/12

viết thế này cũng xoá được dòng có ô in đậm, muốn ngược lại thi sửa True thành False

Em sửa "true" thành "false" nó vẫn xóa các dòng có chữ in đậm anh ơi, Anh sửa code vô file giúp em nhé.....Thanks Anh.

Quang_Hải · 31/5/12

Sub Xoa()
Application.ScreenUpdating = 0
For r = [g65536].End(3).Row To 6 Step -1
If Cells(r, 5).Font.Bold = 0 Then
If Cells(r, 6).Font.Bold = 0 Then
If Cells(r, 7).Font.Bold = 0 Then
Cells(r, 5).EntireRow.Delete
End If
End If
End If
Next
Application.ScreenUpdating = 0
End Sub

concogia · 31/5/12

Locdulieu đã viết:
Em sửa "true" thành "false" nó vẫn xóa các dòng có chữ in đậm anh ơi, Anh sửa code vô file giúp em nhé.....Thanks Anh.

Với code trên, dòng nào có cả 3 cell in đậm thì nó mới "tha", còn không nó....."thịt" hết
Túm lại, không nên dùng For Each...
Híc

Locdulieu · 31/5/12

Với code trên, dòng nào có cả 3 cell in đậm thì nó mới "tha", còn không nó....."thịt" hết

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.

Locdulieu · 31/5/12

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 · 31/5/12

Locdulieu đã viết:
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 · 31/5/12

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 · 31/5/12

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 · 31/5/12

Locdulieu đã viết:
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 · 31/5/12

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 · 31/5/12

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 · 31/5/12

Locdulieu đã viết:
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 · 1/6/12

quanghai1969 đã viết:
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 · 1/6/12

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 · 6/6/12

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 · 6/6/12

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

TrungChinhs · 6/6/12

Locdulieu đã viết:
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 · 7/6/12

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 · 7/6/12

Locdulieu đã viết:
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

PHP:

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:

Application.ScreenUpdating =True

Quang_Hải · 7/6/12

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

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

Locdulieu · 7/6/12

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 · 7/6/12

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 · 7/6/12

Em nghĩ Anh Quanghai có thể thay:

quanghai1969 đã viết:
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

PHP:

.....
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 · 7/6/12

tanthieuhoa đã viết:
Em nghĩ Anh Quanghai có thể thay:

Bằng

PHP:

..... 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

Locdulieu · 7/6/12

Code vẫn chạy đến 102 s anh Quang Hai ơi...có cách nào tối ưu không Anh,còn Code của anh Tân Thiếu Hoa em chạy nó báo lỗi...
Các Anh giúp em hoàn thiện cái này nhé....Em bí quá...Thanks so much...

Quang_Hải · 7/6/12

Trên máy tính của mình chỉ có 2.5 giây thôi

Locdulieu · 7/6/12

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

Code private của Anh Quang Hải cải thiện tốc độ rất nhiều, Anh chỉ nốt em cái chuyển private sub sang module nha Anh, em vào Alt-F11 --->isert module dán đoạn code trên và chạy nó hiện thế này nè Anh

Xin cảm ơn Anh đã lưu tâm giúp đỡ em từ hôm đến giờ...

Bag · 7/6/12

Anh ndu ơi, em mới làm wen với net, thấy giaiphapexcel.com hay nên đăng ký làm thành viên để học hỏi thêm các anh chị. em có vai câu hỏi nhưng không biết làm sao đưa lên diễn đàn, nhờ anh chỉ giúp với. em cảm ơn nhiều.
câu em muôn hỏi là: trong excel dùng nút lệnh gì để có các nút ẩn dòng để khi nhấp vào đó tự động dàn trải ra, nhấp tiền lần nữa là ẩn vào. câu hỏi này có lẽ quá dễ với các nhà lập trình như anh há, nhưng em đang học, mong anh bỏ thời gian chỉ giúp em với.

Quang_Hải · 7/6/12

Locdulieu đã viết:
Code private của Anh Quang Hải cải thiện tốc độ rất nhiều, Anh chỉ nốt em cái chuyển private sub sang module nha Anh, em vào Alt-F11 --->isert module dán đoạn code trên và chạy nó hiện thế này nè Anh
View attachment 83469
Xin cảm ơn Anh đã lưu tâm giúp đỡ em từ hôm đến giờ...

Thi sửa dòng Private Sub CommandButton2_Click()
Thành Sub Xoadong() là xong chuyên rồi

Locdulieu · 7/6/12

Em đã sửa thành module được rùi...code chỉ chạy khoảng 3.6s là ok, nhưng khi em đưa vào chương trình chính gồm nhiều code khác nữa thì code chạy lên đến 38s....Cái này chắc do nhiều code quá nên nó bị chậm hay sao Anh....

Sub shortdata()
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
Columns("A:K").Select
Selection.AutoFilter
Columns("K:K").Select
Selection.ClearContents
Range(Cells(4, "A"), Cells(5, "J")).Select
Application.ScreenUpdating = 1
MsgBox Timer - Start
End Sub
- Khi chạy code này trong file có nhiều code thì thời gian tăng lên 38s....

Thanks Anh Quang Hải nhiều....

tanthieuhoa · 8/6/12

quanghai1969 đã viết:
Hic code của bạn hình như chưa đúng cái vụ i=i+1

Em thử với:

PHP:

.....
i = 4
For Each rng In Range("F4:F" & [j65000].End(3).Row)
If rng.Font.Bold = True Then Cells(i, 11) = 1
If rng.Offset(, 1).Font.Bold = True Then Cells(i, 11) = 1
If rng.Offset(, 2).Font.Bold = True Then Cells(i, 11) = 1
If rng.Offset(, 3).Font.Bold = True Then Cells(i, 11) = 1
If rng.Offset(, 4).Font.Bold = True Then Cells(i, 11) = 1
i = i + 1
Next rng
....

Vẫn thấy chạy nhanh hơn code của anh. Anh test lại xem anh nhé. Thân

Quang_Hải · 8/6/12

tanthieuhoa đã viết:
Em thử với:

PHP:

..... i = 4 For Each rng In Range("F4:F" & [j65000].End(3).Row) If rng.Font.Bold = True Then Cells(i, 11) = 1 If rng.Offset(, 1).Font.Bold = True Then Cells(i, 11) = 1 If rng.Offset(, 2).Font.Bold = True Then Cells(i, 11) = 1 If rng.Offset(, 3).Font.Bold = True Then Cells(i, 11) = 1 If rng.Offset(, 4).Font.Bold = True Then Cells(i, 11) = 1 i = i + 1 Next rng ....

Vẫn thấy chạy nhanh hơn code của anh. Anh test lại xem anh nhé. Thân

Thật ra cái làm chậm code là thủ tục xoá dòng thôi, mình đã test từng đoạn và kiểm tra rồi. Nếu không xoá dòng thì chạy cái vèo là xong rồi

tanthieuhoa · 11/6/12

quanghai1969 đã viết:
Thật ra cái làm chậm code là thủ tục xoá dòng thôi, mình đã test từng đoạn và kiểm tra rồi. Nếu không xoá dòng thì chạy cái vèo là xong rồi

Anh cho em hỏi nếu thay đoạn:

PHP:

Set data = Range([a5], [J65536].End(3).Offset(, 1))
data.AutoFilter 11, ""
data.Offset(1).EntireRow.Delete
AutoFilterMode = False
[k:k].Clear

Bằng:

PHP:

Sheet1.Range("A5:K" & Sheet1.[A65536].End(3).Row).Sort Sheet1.Range("K5"), 1, , , , , , xlYes
If Sheet1.[K65536].End(3).Row > 5 Then
Sheet1.Range("A" & (Sheet1.[K65536].End(3).Row + 1) & ":J" & Sheet1.[A65536].End(3).Row).Clear
End If
[k:k].Clear

Thì có cải thiện tốc độ hơn không anh? Em test thử mà cứ thấy chạy lung tung quá.

Quang_Hải · 11/6/12

Ý tưởng hay. Chạy nhanh gấp 5 lần vì không xóa mà sort dữ liệu và clear

Locdulieu · 11/6/12

Em nhận được file Anh sửa rồi, nó chạy có 2.5s thôi,em cảm ơn Anh Hải và TânThiếuHoa rất nhiều.... :-=

nttam.vnpost · 14/12/13

Thân chào anh ndu96081631, em rất thường xuyên đọc bài viết của anh, tất cả các bài viết rất hay, nhưng e cần 1 đoạn code trong excel nhu vầy ( em có add file đình kèm ). yêu cầu của em là xóa các dòng trong cột vnd khi nó 0.đồng.
vì khi in cước cho khách hàng, chỉ cần in cột vnd có phí là ok rồi.
xin anh chỉ giáo giúp. Xin cảm ơn

anh hướng dẫn xin vui lòng gởi mail dùm e. nttam.vnpost@gmail.com

ChanhTQ@ · 11/9/14

Bạn tham khảo macro sau:

PHP:

Option Explicit
Sub XoaGiaTri0()
 Dim Rng As Range, Cls As Range
 
 Set Rng = Columns("F:F").SpecialCells(xlCellTypeConstants, 3)
 For Each Cls In Rng
    If Cls.Value = 0 Then Cls.Value = ""
 Next Cls
End Sub

Ba Tê · 11/9/14

matkinh đã viết:
mình đang gặp khó khăn xoá Cells =0 từ [F5:f100] nếu Cells nào =0 thì ClearContents tại Cells đó đi thôi chứ không xoá nguyên dòng hay Delete+Shift
mong các bạn trợ giúp cho mình với bằng VBA
Lưu ý chỉ tại Cells có giá trị = o tại chỗ chứ không lọc hay chuyển qua nơi khác rồi mới xoá
Xin cảm ơn

Làm nhiều lần hay lâu lâu lâu làm 1 lần?
Nếu lâu lâu làm 1 lần thì:
Auto Filter cột F
- Chọn trị là 0
- Delete
Bỏ Auto filter
5 giây là xong.

Kiều Mạnh · 12/9/14

matkinh đã viết:
mình đang gặp khó khăn xoá Cells =0 từ [F5:f100] nếu Cells nào =0 thì ClearContents tại Cells đó đi thôi chứ không xoá nguyên dòng hay Delete+Shift
mong các bạn trợ giúp cho mình với bằng VBA
Lưu ý chỉ tại Cells có giá trị = o tại chỗ chứ không lọc hay chuyển qua nơi khác rồi mới xoá
Xin cảm ơn

Bài này chỉ làm đơn giản như vầy là được thôi

PHP:

Sub LoaigiaTrio ()
    [F5:F182].Replace "0", "" 
End Sub

thanhduc_iit · 12/9/14

kieu manh đã viết:
Bài này chỉ làm đơn giản như vầy là được thôi

PHP:

Sub LoaigiaTrio () [F5:F182].Replace "0", "" End Sub

Nếu muốn ẩn dòng mà k xóa thì sao bác?
Ví dụ: Nếu A1:A20 và C1:C20 đều có giá trị bằng 0 thì ẩn dòng đó đi

Kiều Mạnh · 12/9/14

thanhduc_iit đã viết:
Nếu muốn ẩn dòng mà k xóa thì sao bác?
Ví dụ: Nếu A1:A20 và C1:C20 đều có giá trị bằng 0 thì ẩn dòng đó đi

nếu trên một cột thì ẩn được còn hai côt thì khó VD [A1:A20]=1, [C1:C20]=0 THÌ bạn nghĩ xem Ẩn cái gì chứ
còn nếu hai cột có giá trị song song nhau thì mình làm được

Kiều Mạnh · 12/9/14

thanhduc_iit đã viết:
Nếu muốn ẩn dòng mà k xóa thì sao bác?
Ví dụ: Nếu A1:A20 và C1:C20 đều có giá trị bằng 0 thì ẩn dòng đó đi

Nếu hai cột có giá trị như nhau thì bạn sử dụng code sau nha chỉ cần đặt điều kiện tại [A1:A20] thôi là được

PHP:

Sub Hide_Rowo()
  Dim Rng As Range
  Application.ScreenUpdating = False
    For Each Rng In [A2:A20]
      If Rng.Value = "" Or Rng.Value = 0 Then Rng.EntireRow.Hidden = True
    Next Rng
  Application.ScreenUpdating = True
End Sub

VetMini · 12/9/14

Ba Tê đã viết:
Làm nhiều lần hay lâu lâu lâu làm 1 lần?
Nếu lâu lâu làm 1 lần thì:
...

Bạn hỏi câu này vô ích. Hồi nào tới giờ tôi chưa hề thấy người nào muốn code mà chấp nhận thủ công cả. Đương nhiên câu trả lời luôn luôn là "nhiều lần".

Tuy rằng, chính tôi vẫn làm cái này đều đặn. Và tôi chả buồn nghĩ tới làm bằng VBA. Dẫu cho có sẵn code, chỉ riêng import code đã lâu hơn làm tay rồi.

thanhduc_iit · 13/9/14

kieu manh đã viết:
Nếu hai cột có giá trị như nhau thì bạn sử dụng code sau nha chỉ cần đặt điều kiện tại [A1:A20] thôi là được

PHP:

Sub Hide_Rowo() Dim Rng As Range Application.ScreenUpdating = False For Each Rng In [A2:A20] If Rng.Value = "" Or Rng.Value = 0 Then Rng.EntireRow.Hidden = True Next Rng Application.ScreenUpdating = True End Sub

Ở cột A và C đều có giá trị 0 thì mới ẩn bác ạ. Nếu 1 trong 2 cột có giá trị 0 thì k ẩn đi

Kiều Mạnh · 13/9/14

thanhduc_iit đã viết:
Ở cột A và C đều có giá trị 0 thì mới ẩn bác ạ. Nếu 1 trong 2 cột có giá trị 0 thì k ẩn đi

Vậy thử test đi nếu có gì không ổn ta tính tiếp.... giúp được gì thì mình giúp cho...vả lại mình cũng đang luyện code mà...
tẩu hoả nhập ma là thường thôi

thanhduc_iit · 15/9/14

kieu manh đã viết:
Vậy thử test đi nếu có gì không ổn ta tính tiếp.... giúp được gì thì mình giúp cho...vả lại mình cũng đang luyện code mà...
tẩu hoả nhập ma là thường thôi

Code trên của bác chỉ chạy ở 1 cột A thôi.
Vấn đề em muốn là chạy cùng lúc cột A và C. Nếu A và C đều bằng 0 thì ẩn nó đi

Ba Tê · 15/9/14

thanhduc_iit đã viết:
Code trên của bác chỉ chạy ở 1 cột A thôi.
Vấn đề em muốn là chạy cùng lúc cột A và C. Nếu A và C đều bằng 0 thì ẩn nó đi

Thử cái này coi sao, ô rỗng cũng coi như =0

PHP:

Public Sub Andong()
Dim R As Long, I As Long
R = Range("A65536").End(xlUp).Row
Cells.EntireRow.Hidden = False
For I = 1 To R
    If Range("A" & I) = 0 And Range("C" & I) = 0 Then Range("A" & I).EntireRow.Hidden = True
Next I
End Sub

SonBDND · 15/1/25

Locdulieu đã viết:
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

Khi chạy cột e bị xóa thì cột f bị dồn lại vị trí vọt e. Lúc này điều kiện lại đúng và nó xóa tiếp

"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel (1 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

File đính kèm

Huyền thoại GPE

VBA & VB.NET for Excel & AutoCad

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên gạo cội

Gội rồi mới Cạo

Thành viên mới

Thành viên mới

Thành viên gạo cội

File đính kèm

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Gội rồi mới Cạo

Thành viên tích cực

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên tích cực

File đính kèm

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

0901452không62

Cạo Rồi Khỏi Gội

I don't program, I beat code into submission!!!

Thành viên chính thức

I don't program, I beat code into submission!!!

I don't program, I beat code into submission!!!

Đang đi tìm hòn đá

Thành viên chính thức

I don't program, I beat code into submission!!!

Thành viên chính thức

Cạo Rồi Khỏi Gội

Thành viên mới

Thời gian đếm ngược.