Xóa dòng trống kèm điều kiện

Liên hệ QC

hadoan-pap

Thành viên tiêu biểu
Tham gia
8/7/15
Bài viết
453
Được thích
18
Dear mọi ng.

Em có them 1 bài toán nhỏ như file đính kèm ạ.

Em muốn chạy hết hang của cột B và cột D để xóa bỏ những dòng trống bên dưới kèm điều kiện là cả 2 hang của cột B và D cùng rỗng thì nó mới xóa. Tức là nếu chỉ hang X cột B mà rỗng , trong khi hang X cột D có data thì nó k xóa... nó chỉ xóa tất cả dòng trống trở xuống chỉ khi cả hàng X ở cột B và D cùng rỗng.

E cảm ơn ạ!
 

File đính kèm

  • Sample File.xlsm
    24.8 KB · Đọc: 11
Bạn tham khảo bài hỏi này có liên quan với bài hỏi của bạn.
Xem các bài trả lời tiếp bên dưới.
https://giaiphapexcel.com/diendan/threads/chuyên-đề-giải-đáp-những-thắc-mắc-về-code-vba.83698/post-893793
Ui, e cảm ơn nhưng bài viết đó dài quá ạ :)...

A có thể giúp em 1 đoạn code ngắn để e học hỏi áp dung vào bài toán thực tế của em đc k ạ ?

E cảm ơn .
 
Upvote 0
Ui, e cảm ơn nhưng bài viết đó dài quá ạ :)...

A có thể giúp em 1 đoạn code ngắn để e học hỏi áp dung vào bài toán thực tế của em đc k ạ ?

E cảm ơn .
Bạn đưa file "giống thật" lên xem giữa cột E và N là kiểu dữ liệu gì, Tất cả các cột khác có dữ liệu không?
Dữ liệu không thật thì cách giải quyết cũng chưa thật đâu.
 
Upvote 0
Code đó sẽ xóa hết công thức của bạn.
Hi Snow,

Tớ chỉ muốn xóa hết các dòng trống bên dưới thôi cậu ạ, hang nào mà có data thì nó k xóa.

Cụ thể là nó chạy từ trên xuống dưới ( khoảng 400 dòng ), dòng nào mà trống là nó bắt đầu xóa từ đó cho đến hết các dòng trống khác.
Bài đã được tự động gộp:

Bạn đưa file "giống thật" lên xem giữa cột E và N là kiểu dữ liệu gì, Tất cả các cột khác có dữ liệu không?
Dữ liệu không thật thì cách giải quyết cũng chưa thật đâu.
Dear anh,

Dạ, nó là file e gửi e ví dụ trong Sheet5

Dữ lieu có công thức ạ, nhưng nó chỉ có 2 cột thôi. E muốn nó chạy từ trên xuống dưới, cứ dòng nào mà ở cột E và cột N rỗng thì nó xóa tất ạ....

File chỉ có 2 cột này là chính thôi, các cột khác k có data, công thức đâu ạ.
 

File đính kèm

  • Sample File.xlsm
    30.9 KB · Đọc: 8
Lần chỉnh sửa cuối:
Upvote 0
Hi Snow,

Tớ chỉ muốn xóa hết các dòng trống bên dưới thôi cậu ạ, hang nào mà có data thì nó k xóa.

Cụ thể là nó chạy từ trên xuống dưới ( khoảng 400 dòng ), dòng nào mà trống là nó bắt đầu xóa từ đó cho đến hết các dòng trống khác.
Bài đã được tự động gộp:


Dear anh,

Dạ, nó là file e gửi e ví dụ trong Sheet5

Dữ lieu có công thức ạ, nhưng nó chỉ có 2 cột thôi. E muốn nó chạy từ trên xuống dưới, cứ dòng nào mà ở cột E và cột N rỗng thì nó xóa tất ạ....

File chỉ có 2 cột này là chính thôi, các cột khác k có data, công thức đâu ạ.
Viết trao đổi nhau dùng thuần tiếng Việt thôi. "Dear anh" nghe chõi tai quá.
Khoảng 400 dòng thì xài thử Sub này cho sheet5
PHP:
Sub GPE()
Application.ScreenUpdating = False
Dim I As Long, R1 As Long, R2 As Long, Rws As Long
With Sheet5
    R1 = .Range("E50000").End(xlUp).Row
    R2 = .Range("N50000").End(xlUp).Row
    Rws = IIf(R1 > R2, R1, R2)
    For I = Rws To 1 Step -1
        If Len(.Cells(I, 5)) = 0 And Len(.Cells(I, 14)) = 0 Then
           Rows(I).Delete
        End If
    Next I
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Bạn đưa file "giống thật" lên xem giữa cột E và N là kiểu dữ liệu gì, Tất cả các cột khác có dữ liệu không?
Dữ liệu không thật thì cách giải quyết cũng chưa thật đâu.
Viết trao đổi nhau dùng thuần tiếng Việt thôi. "Dear anh" nghe chõi tai quá.
Khoảng 400 dòng thì xài thử Sub này cho sheet5
PHP:
Sub GPE()
Application.ScreenUpdating = False
Dim I As Long, R1 As Long, R2 As Long, Rws As Long
With Sheet5
    R1 = .Range("E50000").End(xlUp).Row
    R2 = .Range("N50000").End(xlUp).Row
    Rws = IIf(R1 > R2, R1, R2)
    For I = Rws To 1 Step -1
        If Len(.Cells(I, 5)) = 0 And Len(.Cells(I, 14)) = 0 Then
           Rows(I).Delete
        End If
    Next I
End With
Application.ScreenUpdating = True
End Sub
Anh ơi e cảm ơn nhé.

E tìm đc đoạn code khá ngắn nhưng nó chạy có vẻ chậm nếu nhiều dòng :).. Code anh e thấy ok rồi ạ.

Dim iCntr
Dim rng As Range
Set rng = Range("E5:N200")
For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next
 
Upvote 0
Dear Anh,

Em co thử nhưng chưa đc ạ.

Mọi ng giúp em 1 đoạn code nào càng ngắn xúc tích với ạ.

Mục tiêu là biến sẽ chạy từ trên xuống dưới để tìm xem hang nào mà rỗng cả ở 2 cột thì nó mới bắt đầu Delete từ đó xuống tất cả ạ.
Mã:
Sub Sheet5_Button1_Click()
Dim lRw As Long, lRw1 As Long, Dg As Long
Dim Rng As Range, Cls As Range, dRg As Range

lRw = ActiveSheet.Range("E65500").End(xlUp).Row
lRw1 = Sheet4.Range("N65500").End(xlUp).Row
If lRw1 > lRw Then Dg = lRw1 Else Dg = lRw
Set Rng = Range("E5:E" & lRw):
For r = Rng.Rows.Count To 1 Step -1
    If Rng.Cells(r, 1) = "" And Rng.Cells(r, 10).Value = "" Then
    Rng.Rows(r).EntireRow.Delete
    MsgBox Rng.Cells(r, 1).Address & "" & Rng.Cells(r, 10).Address
    End If
Next
End Sub
Mượn code của bạn design lại xíu, bạn tùy biến theo ý bạn nhé
 
Upvote 0
Mã:
Sub Sheet5_Button1_Click()
Dim lRw As Long, lRw1 As Long, Dg As Long
Dim Rng As Range, Cls As Range, dRg As Range

lRw = ActiveSheet.Range("E65500").End(xlUp).Row
lRw1 = Sheet4.Range("N65500").End(xlUp).Row
If lRw1 > lRw Then Dg = lRw1 Else Dg = lRw
Set Rng = Range("E5:E" & lRw):
For r = Rng.Rows.Count To 1 Step -1
    If Rng.Cells(r, 1) = "" And Rng.Cells(r, 10).Value = "" Then
    Rng.Rows(r).EntireRow.Delete
    MsgBox Rng.Cells(r, 1).Address & "" & Rng.Cells(r, 10).Address
    End If
Next
End Sub
Mượn code của bạn design lại xíu, bạn tùy biến theo ý bạn nhé
Cảm ơn bạn nhé :)
Bài đã được tự động gộp:

Viết trao đổi nhau dùng thuần tiếng Việt thôi. "Dear anh" nghe chõi tai quá.
Khoảng 400 dòng thì xài thử Sub này cho sheet5
PHP:
Sub GPE()
Application.ScreenUpdating = False
Dim I As Long, R1 As Long, R2 As Long, Rws As Long
With Sheet5
    R1 = .Range("E50000").End(xlUp).Row
    R2 = .Range("N50000").End(xlUp).Row
    Rws = IIf(R1 > R2, R1, R2)
    For I = Rws To 1 Step -1
        If Len(.Cells(I, 5)) = 0 And Len(.Cells(I, 14)) = 0 Then
           Rows(I).Delete
        End If
    Next I
End With
Application.ScreenUpdating = True
End Sub
Anh BaTe ơi cho em hỏi xíu ạ.

E có đoạn code bên dưới :

Sheet8.Range("B2:D100").Copy
a = Sheet2.Range("E5").End(xlDown).Row + 1
Sheet2.Range("E" & a).PasteSpecial Paste:=xlPasteValues

Code này sẽ tìm dòng trống trong cột E, bắt đầu từ E5 ... Nếu dòng nào trống sẽ Paste data vào. Code này
Viết trao đổi nhau dùng thuần tiếng Việt thôi. "Dear anh" nghe chõi tai quá.
Khoảng 400 dòng thì xài thử Sub này cho sheet5
PHP:
Sub GPE()
Application.ScreenUpdating = False
Dim I As Long, R1 As Long, R2 As Long, Rws As Long
With Sheet5
    R1 = .Range("E50000").End(xlUp).Row
    R2 = .Range("N50000").End(xlUp).Row
    Rws = IIf(R1 > R2, R1, R2)
    For I = Rws To 1 Step -1
        If Len(.Cells(I, 5)) = 0 And Len(.Cells(I, 14)) = 0 Then
           Rows(I).Delete
        End If
    Next I
End With
Application.ScreenUpdating = True
End Sub
Anh ơi.

Anh có thể xem giúp e đoạn code này có tí xíu nhầm ở đâu mà khi e chạy nó Paste có vẻ sai sai 1 chút ạ.

Sheet8.Range("B2:D100").Copy
a = Sheet2.Range("E5").End(xlUp).Row + 1
Sheet2.Range("E" & a).PasteSpecial Paste:=xlPasteValues

Mục đích là e đang tìm dòng trống từ E5 trở xuống để paste data vào ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Gửi mọi ng.

Em có đoạn code này nhưng chạy hơi sai sai. K rõ nhầm ở đâu ạ... Mục đích là tìm dòng trống từ E5 trở xuống để Paste dữ lieu vào ạ.

Sheet8.Range("B2:D100").Copy

a = Sheet2.Range("E5").End(xlUp).Row + 1
Sheet2.Range("E" & a).PasteSpecial Paste:=xlPasteValues
Bài đã được tự động gộp:

Cảm ơn mọi ng rất nh e xử lý dc rồi ạ :)
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom