"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]

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]

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

 

[Locdulieu]

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]

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]

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]

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]

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

Em thử với:

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

Em thử với:

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

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:

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

Bằng:

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]

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

 

[Locdulieu]

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]

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@]

Bạn tham khảo macro sau:

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ê]

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]

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

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

 

[thanhduc_iit]

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

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]

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]

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

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]

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]

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

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