Xóa dòng trống theo điều kiện của 1 cột.

  • Thread starter Thread starter Thien
  • Ngày gửi Ngày gửi
Liên hệ QC

Thien

Thành viên thường trực
Tham gia
23/6/06
Bài viết
352
Được thích
113
Chào cả nhà.
Mình sưu tầm được 1 đoạn code cho phép xóa dòng theo điều kiện của 1 cột.
Mã:
Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

            'We check the values in the A column in this example
            With .Cells(Lrow, "B")

                If Not IsError(.Value) Then

                    If .Value = "0" Then .EntireRow.Delete
                    'This will delete each row with the Value "ron"
                    'in Column A, case sensitive.

                End If

            End With

        Next Lrow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub
.

Có vấn đề phát sinh là nếu dữ liệu có khoảng 40.000 dòng thì code trên chạy rất lâu.
Hiện Tôi đang dùng code này nhưng thấy chậm nên lên đây nhờ các bạn có code nào chạy nhanh hơn hoặc cải tiến được code thì tốt quá.
Tôi biết do tổ chức CSDL chưa hợp lý nên có nhiều dòng trống trong 40.000 dòng. Mong các bạn đừng bàn luận & phán xét.

Thân chào.
 
Tìm kiếm trên diễn đàn i!

Bạn dùng từ khóa 'Union' & tìm trên diễn đàn;
trong đó ở trang 1 hay 2 có bài "Xóa dòng trống, bị lỗi, xin chỉ dùm. . . "
(Trong bài này mình có cách gom hết các dòng thỏa điều kiện = phw thức UNION() & xóa 1 lần!
Bạn thử xem có nhanh hơn không nha!

(húc &ui &ẽ!!!
 
Upvote 0
SA_DQ đã viết:
Bạn dùng từ khóa 'Union' & tìm trên diễn đàn;
trong đó ở trang 1 hay 2 có bài "Xóa dòng trống, bị lỗi, xin chỉ dùm. . . "
(Trong bài này mình có cách gom hết các dòng thỏa điều kiện = phw thức UNION() & xóa 1 lần!
Bạn thử xem có nhanh hơn không nha!
(húc &ui &ẽ!!!

Tìm không ra Anh ơi.(chức năng tìm trong diễn đàn không ổn rùi).

Thân.
 
Upvote 0
Thử cái ni xem sao:

Mã:
Option Explicit[b]

Sub DeleteRows()[/b]
 Dim Rng As Range, UnRng As Range
 Dim Timer_ As Double
 
 
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    Timer_ = Timer
    For Each Rng In Selection
        If Rng = 0 Then
            If UnRng Is Nothing Then
                Set UnRng = Rng.EntireRow
            Else
                Set UnRng = Union(UnRng, Rng.EntireRow)
        End If:         End If
    Next Rng
    UnRng.Select
    Selection.Delete
    MsgBox Str(Timer - Timer_)
[COLOR="Blue"] '8027 dòng hàm =Int(RAND()*5) (Paste Value) trong vòng   11.3125
 ' Xóa còn 6640      [/COLOR][b]
End Sub [/b]
 
Lần chỉnh sửa cuối:
Upvote 0
Không giải quyết được vấn đề bạn ơi.
Mời các bạn thử nhen.
 

File đính kèm

Upvote 0
Càng ngắn hơn về code!

Mã:
[b]
Sub DelectPlank()[/b]
  Dim Rng As Range, UnRng As Range
  Dim Timer_ As Double
  Timer_ = Timer
  Range("F9:F" & Range("F65432").End(xlUp).Row).Select
  Selection.SpecialCells(xlCellTypeBlanks).Select
  Selection.EntireRow.Delete
  MsgBox Str(Timer - Timer_)
[COLOR="Blue"][B][I]  ' 26.046875 là thời gian tiêu tốn tại máy của mình [/I][/B][/COLOR] [b]
End Sub[/b]
 
Upvote 0
Bác Sa ơi!
Theo em chỉ cần 1 dòng
Range("F1:F" & Range("B65432").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Như em chưa biết làm khi nó không có cells nào rỗng.
 
Upvote 0
(ảm ơn ThuNghi nha!!!

Như em chưa biết làm khi nó không có cells nào rỗng.

Bẫy lỗi, chấp nhận được không (?):
Mã:
[b]Sub ErrDelete()[/b]
On Error GoTo LoiSSSS
 Range("A1:A" & Range("A65432").End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ErrSSSS:   Exit Sub
LoiSSSS:                    'MsgBox Str(Err)
    Resume ErrSSSS
[b]End Sub[/b]
 
Upvote 0
Không hiểu sao áp dụng code của Anh SA_DQ vào file của mình không có tác dụng nhỉ?.
Có bạn nào làm hộ 1 file nhen.

Thân.
 
Upvote 0
Thien đã viết:
Không hiểu sao áp dụng code của Anh SA_DQ vào file của mình không có tác dụng nhỉ?.
Có bạn nào làm hộ 1 file nhen.

Thân.

Code trên áp dụng cho cột A, bạn thay đổi cho code phù hợp với dữ liệu của bạn (column nào có dữ liệu trống mà bạn muốn xoá)

Range("A1:A" & Range("A65536").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Thân.
 
Upvote 0
Cảm ơn bạn Soibien.

Mã:
Sub ErrDelete()
On Error GoTo LoiSSSS
 Range("H9:H" & Range("H65432").End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ErrSSSS:   Exit Sub
LoiSSSS:                    'MsgBox Str(Err)
    Resume ErrSSSS
End Sub
.

Vẫn cứ trơ ra như chưa làm gì là do trong cột H mình có cài công thức =IF(F14<>0,1,0), nếu thay cột H bằng cột F thì OK thôi mà.

TC.
 
Lần chỉnh sửa cuối:
Upvote 0
/-(ãy xem xét kỹ lệnh Goto trong menu Edit

Dòng lệnh
Mã:
 Range("H9:H" & Range("H65432").End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).EntireRow.Delete
sẽ được diễn dịch từ ngôn ngữ VBA sang ngôn ngữ chúng ta quen xài, như sau:
Xóa ~ dòng nào, mà các ô trên cột H từ H9 cho đến cuối dữ liệu là ~ ô rỗng!
Mà ô của bạn có cái nào rỗng đâu, ô nào cũng chứa công thức cả là; chỉ có điều, kết quả công thức trả về là giá trị rỗng! Hai chuyện này # nhau xa lắm, trong excel!

Để làm quen với lệnh loại này, bạn nhuyễn với lệnh Goto trong menu Edit mới được;

(ách khác : bạn cứ mạnh dạng xóa ngay tại cột 'F', sau một số lần khẳng định rằng đoạn code này dành cho mình!

(húc vui!!:-=
 
Lần chỉnh sửa cuối:
Upvote 0
Code trên áp dụng cho cột A, bạn thay đổi cho code phù hợp với dữ liệu của bạn (column nào có dữ liệu trống mà bạn muốn xoá)

Range("A1:A" & Range("A65536").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Thân.
Cả nhà ơi! nhân tiện cho Em hỏi chút. Code trên là xoá OK rùi. Nhưng muốn ẩn (hoặc hiện) dòng theo điều kiện cột có giá trị = 0 thì dùng code nào hả bác. Cám ơn cả nhà
 
Upvote 0
Cuối cùng cũng tự mò ra vậy.
Sub vd() ' Xoa dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub vd1() ' An dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'EntireRow.Delete
End Sub
Sub vd2() ' Hien dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
End Sub

Sub vd3() 'Hien tat ca cac dong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
EntireRow.Hidden = False
End Sub
 
Upvote 0
Cuối cùng cũng tự mò ra vậy.
Sub vd() ' Xoa dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub vd1() ' An dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'EntireRow.Delete
End Sub
Sub vd2() ' Hien dong co cot A trong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
End Sub

Sub vd3() 'Hien tat ca cac dong
Range("A3:A" & Range("A65432").End(xlUp).Row). _
EntireRow.Hidden = False
End Sub
Chẳng thấy bẫy lỗi gì cả thế!
Đoạn code đầu tiên ấy, bạn thử chạy 1 lần, xong chạy tiếp lần nữa xem nó báo lỗi gì nhé!
 
Upvote 0
Chẳng thấy bẫy lỗi gì cả thế!
Đoạn code đầu tiên ấy, bạn thử chạy 1 lần, xong chạy tiếp lần nữa xem nó báo lỗi gì nhé!

Sub vd() ' Xoa dong co cot A trong
On Error GoTo thoat
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
thoat: Exit Sub
End Sub

Bác ndu ơi. Ngoại trừ cái sub vd3() còn lại là phải bẫy lỗi tất cả như trên được chưa bác.
 
Upvote 0
Sub vd() ' Xoa dong co cot A trong
On Error GoTo thoat
Range("A3:A" & Range("A65432").End(xlUp).Row). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
thoat: Exit Sub
End Sub

Bác ndu ơi. Ngoại trừ cái sub vd3() còn lại là phải bẫy lỗi tất cả như trên được chưa bác.
Nói chung, tất cả các code dùng SpecialCell đều phải bẫy lỗi trong trường hợp điều kiện tìm kiếm không thỏa mản
Thêm 1 chút: Với code này, bạn có tính đến trường hợp nguyên cột A chỉ có A3 là có dữ liệu không? ---> Chạy code thử trường hợp này xem thế nào nhé
Nói chung: SpecialCell rất nguy hiểm và rất khó khống chế ---> Trong 1 trường hợp cụ thể nào đó có thể nó sẽ làm cho dữ liệu của bạn tan tành (sau khi chạy code)
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom